home *** CD-ROM | disk | FTP | other *** search
/ Aminet 37 / Aminet 37 (2000)(Schatztruhe)[!][Jun 2000].iso / Aminet / util / rexx / FWCalendar.lha / FWCalendar / FWCalendar.rexx < prev    next >
OS/2 REXX Batch file  |  2000-03-04  |  138KB  |  3,816 lines

  1. /*
  2.    FWCalendar.rexx Macro
  3.    Creates calendars on FinalWriter v 4.x (SoftWood) & PageStream v 3.x
  4.    $VER: FWCalendar.rexx v3.82 (4 Mar 2000)
  5.    ©Ron Goertz (goertz@earthlink.net)
  6. */
  7.  
  8. options results
  9. signal on syntax
  10.  
  11. call AddLibraries
  12. bguiopen = bguiopen()
  13. if ErrorCount > 0 then call Cleanup
  14.  
  15. address value DetermineHost()
  16. call GetSetupInfo
  17. call SetVariables
  18.  
  19. /*************************/
  20. /***//* Yearly Calendar  */
  21. /*************************/
  22. if CalType == 2 then do
  23.   EventCount = 389
  24.   if App == 'FW' then VIEW 20
  25.   else if App == 'PGS' then do
  26.     if DoHide == 1 then HIDEWINDOW
  27.     else DISPLAY SCALE 25
  28.     REFRESH OFF
  29.   end
  30.  
  31.   Gen$ = GeneratingY$
  32.   Do i = 1 to words(GenYVars)
  33.     InsertPos = pos('%s', Gen$)
  34.     if InsertPos == 0 then leave
  35.     Gen$ = left(Gen$, InsertPos - 1)''value(word(GenYVars, i))''substr(Gen$, InsertPos + 2)
  36.   end
  37.   Req = OpenBusy(Gen$'...', EventCount)
  38.  
  39.   call MiniCalPreCalc(FYMiniCal, MiniCalWidth)
  40.  
  41.   Year = EnteredYear
  42.   CalTop = Margin.Top
  43.   do r = 0 to 3
  44.     Margin.Top = CalTop + r * (7*Height.FYMiniCal + MiniCalSpacing)
  45.     do c = 0 to 2
  46.       Month = r * 3 + c + 1
  47.       Mn = right(Month, 2, '0')
  48.       TempDate = Year''Mn'01'
  49.       if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2 = 29
  50.       interpret 'StartDate = Day.'DateInfo('W', TempDate, 'S')
  51.       call DrawMiniCal(0, MiniCalWidth, FYMiniCal)
  52.     end
  53.   end
  54.  
  55.   if DoCopyright == 1 then call RightText(PrintText(0, CalTop + 28 * Height.FYMiniCal + 3 * MiniCalSpacing, 4pt, 'N', Black$, 100, CNotice), Margin.Left + PrintWidth)
  56.  
  57.   call Cleanup
  58. end
  59. /**/
  60.  
  61. /*************************/
  62. /***//* Monthly Calendar */
  63. /*************************/
  64. Year = EnteredYear
  65.  
  66. PrevMonth = Month - 1
  67. if PrevMonth = 0 then do
  68.   PrevMonth = 12
  69.   PrevYear = Year - 1
  70. end
  71. else PrevYear = Year
  72.  
  73. NextMonth = Month + 1
  74. if NextMonth = 13 then do
  75.   NextMonth = 1
  76.   NextYear = Year + 1
  77. end
  78. else NextYear = Year
  79.  
  80. if (DoSunRise ~= 0) | (DoSunSet ~= 0) then do
  81.   StartDST = DateInfo('I', Year'04'right(CalculateDate( 4, 'Monday', 7,  ''), 2, '0'), 'S') /* First Sunday in April */
  82.   EndDST   = DateInfo('I', Year'10'CalculateDate(10, 'Friday', 31, ''), 'S') /* Last Sunday in October */
  83. end
  84.  
  85. if DoPhases ~= 0 then CountPhases = 1
  86. if DoJulian ~= 0 then CountJulian = 1
  87. if DoJulianLeft ~= 0 then CountJulianLeft = 1
  88. if DoSunRise ~= 0 then CountSunRise = 1
  89. if DoSunSet ~= 0 then CountSunSet = 1
  90. EventCount = 40 +,
  91.              (MonthLength.Month + 5) * (1 + CountSunRise + CountSunSet + DoDateBox + CountJulian + CountJulianLeft) +,
  92.              HighlightCount * (DoBackgrounds + DoHighlights) +,
  93.              (DoExtended*2 + 8) * DoBackgrounds +,
  94.              ImageCount * DoImages +,
  95.              DoMiniCals * (MonthLength.NextMonth + MonthLength.PrevMonth + 4) +,
  96.              CountPhases * 5
  97.  
  98. if App == 'FW' then VIEW 20
  99. else if App == 'PGS' then do
  100.   if DoHide == 1 then HIDEWINDOW
  101.   else DISPLAY SCALE 25
  102. end
  103.  
  104. Gen$ = GeneratingM$
  105. Do i = 1 to words(GenMVars)
  106.   InsertPos = pos('%s', Gen$)
  107.   if InsertPos == 0 then leave
  108.   Gen$ = left(Gen$, InsertPos - 1)''value(word(GenMVars, i))''substr(Gen$, InsertPos + 2)
  109. end
  110. Req = OpenBusy(Gen$'...', EventCount)
  111.  
  112. /************************/
  113. /* Finally, the program */
  114. /************************/
  115. if App == 'PGS' then do
  116.   if DoHide == 1 then REFRESH OFF
  117. end
  118.  
  119. TempDate  = Year''Mn'01'
  120. IDay      = DateInfo('I', TempDate, 'S') - 1
  121. interpret 'StartYear = Day.'DateInfo('W', Year'0101', 'S')
  122.  
  123. YearOffset = 7 - StartYear
  124. if YearOffset == 7 then YearOffset = 0
  125.  
  126. if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then do
  127.   LeapYear = 1
  128.   MonthLength.2 = 29
  129. end
  130. else LeapYear = 0
  131.  
  132. if (PrevYear//4 == 0 & PrevYear//100 > 0) | PrevYear//400 == 0 Then PrevLeapYear = 1
  133. else PrevLeapYear = 0
  134.  
  135. interpret 'StartDate = Day.'DateInfo('W', TempDate, 'S')
  136. if (DoHighlights == 1) | (DoImages == 1) then call SetHighLights
  137. if DoPhases ~= 0 then call GetPhases(Year, Month)
  138.  
  139. /* In PGS, no other objects should be drawn overlapping 0,0 */
  140. PrefsString = 'FWC'TempDate''PrefsFile
  141. if (length(PrefsString) > 31) & (App == 'FW') then do
  142.   StringCount = trunc(length(PrefsString) / 25)
  143.   NextString = 0
  144.   do i = StringCount to 0 by -1
  145.     PrintString = substr(PrefsString, (i * 25) + 1, 25)
  146.     if NextString ~= 0 then PrintString = PrintString'|'NextString'|'
  147.     NextString = PrintText(0, 0, 4pt, 'N', White$, 100, PrintString)
  148.   end
  149. end
  150. else call PrintText(0, 0, 4pt, 'N', White$, 100, PrefsString)
  151.  
  152. /***//* Draw dates and optional highlights */
  153. Day         = - StartDate
  154. LineTop.    = CalTop
  155. LineBottom. = CalTop + BoxHeight*5
  156. LineLeft.   = Margin.Left
  157. LineRight.  = CalRight
  158. BackBox.    = 0
  159.  
  160. Width.WidthOfDate1 = GetFontWidth(Date, 'N', '1')
  161. Width.WidthOfDate8 = GetFontWidth(Date, 'N', '8')
  162.  
  163. Do i = 0 to 5
  164.   if i = 5 then do
  165.     BoxTop = CalTop + BoxHeight*4.5
  166.     BHeight = BoxHeight/2
  167.   end
  168.   else do
  169.     BoxTop  = CalTop + BoxHeight*i
  170.     BHeight = BoxHeight
  171.   end
  172.                  
  173.   Do j = 0 to 6
  174.     Day = Day + 1
  175.     JulianDay = IDay + Day
  176.     BoxLeft = Margin.Left + BoxWidth * j
  177.  
  178.     /* Days for previous & next months */
  179.     If (Day < 1) | (Day > MonthLength.Month) then do
  180.  
  181.       /* Previous month */
  182.       if Day < 1 then do
  183.         PrintDay = MonthLength.PrevMonth + Day
  184.         LineTop.j = CalTop + BoxHeight
  185.         LineLeft.0 = Margin.Left + BoxWidth * (j + 1)
  186.       end
  187.  
  188.       /* Next month */
  189.       else do
  190.         PrintDay = Day - MonthLength.Month
  191.         interpret 'LineBottom.'j+1' = 'CalTop + BoxHeight*4
  192.         CalRow = i + 1
  193.         if LineRight.CalRow == CalRight then LineRight.CalRow = Margin.Left + BoxWidth * j
  194.       end
  195.  
  196.       if DoExtended then do
  197.         if (j = Day.Sunday | j = Day.Saturday) & (DoBackgrounds == 1) & (Background.Weekend ~= White$) then do
  198.           BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, Background.Weekend, 1)
  199.           call UpdateBusy(Req, 1)
  200.         end
  201.  
  202.         DayType = 'Extended'
  203.         if BackBox.JulianDay ~= 0 then TextColor = AltColor.Extended
  204.         else TextColor = Color.Extended
  205.         DayID = PrintText(BoxLeft + DateOffset, BoxTop, Date, 'N', TextColor, Width.Date, PrintDay)
  206.         call UpdateBusy(Req, 1)
  207.         if DoDateBox == 1 then do
  208.           if BackBox.JulianDay ~= 0 then BoxColor = AltColor.Extended
  209.           else BoxColor = Color.Extended
  210.           call BoxDate(DayID, BoxColor)
  211.           call UpdateBusy(Req, 1)
  212.         end
  213.         call DoOptions
  214.       end
  215.     end
  216.  
  217.     /* Days for current month */
  218.     else do
  219.       if i = 5 then do
  220.         PrevJulianDay = JulianDay - 7
  221.         call DrawLine(BoxLeft, BoxTop, BoxLeft + BoxWidth, BoxTop, 'HL', Line.Grid)
  222.         if BackBox.PrevJulianDay ~= 0 then call HalveBox(BackBox.PrevJulianDay)
  223.         call UpdateBusy(Req, 1)
  224.       end
  225.  
  226.       if (j = Day.Sunday | j = Day.Saturday) & (DoBackgrounds == 1) & (Background.Weekend ~= White$) then BackBox.JulianDay = -1
  227.  
  228.       /* Print Highlight */
  229.       if Highlight.Month.Day ~= '' & DoHighlights == 1 then do
  230.         if TopOption ~= 0 then Highlight.Month.Day = '//'Highlight.Month.Day
  231.         DailyHLCount = 0
  232.         SearchPos    = 1
  233.         Found        = 1
  234.         do until Found == 0
  235.           Found = pos('//', Highlight.Month.Day, SearchPos)
  236.           if Found > 0 then do
  237.             HighlightText = substr(Highlight.Month.Day, SearchPos, Found - SearchPos)
  238.             SearchPos = Found + 2
  239.           end
  240.           else HighlightText = substr(Highlight.Month.Day, SearchPos)
  241.  
  242.           /* Draw background colors for highlight days */
  243.           if DoBackgrounds == 1 then do
  244.             if right(HighlightText, 1) == '#' then do
  245.               BoxColor = Background.HighlightH
  246.               if (BoxColor ~= White$) then TextColor = AltColor.HighlightH
  247.               else TextColor = Color.HighlightH
  248.             end
  249.             else do
  250.               BoxColor = Background.Highlight
  251.               if (BoxColor ~= White$) then TextColor = AltColor.Highlight
  252.               else TextColor = Color.Highlight
  253.             end
  254.             if (BackBox.JulianDay < 1 ) & (BoxColor ~= White$) then do
  255.               BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, BoxColor, 1)
  256.               call UpdateBusy(Req, 1)
  257.             end
  258.           end
  259.           else do
  260.             if right(HighlightText, 1) == '#' then TextColor = Color.HighlightH
  261.             else TextColor = Color.Highlight
  262.           end
  263.  
  264.           Select
  265.             when Day < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
  266.             when Day < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
  267.             otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
  268.           end
  269.  
  270.           call PrintHighlight(compress(HighlightText, '#'))
  271.           call UpdateBusy(Req, 1)
  272.  
  273.           DailyHLCount = DailyHLCount + 1
  274.         end
  275.       end
  276.       else do
  277.         if DoDailyColors == 1 then do
  278.           Select
  279.             when j == Day.Sunday then TextColor = Color.Sunday
  280.             when j == Day.Monday then TextColor = Color.Monday
  281.             when j == Day.Tuesday then TextColor = Color.Tuesday
  282.             when j == Day.Wednesday then TextColor = Color.Wednesday
  283.             when j == Day.Thursday then TextColor = Color.Thursday
  284.             when j == Day.Friday then TextColor = Color.Friday
  285.             when j == Day.Saturday then TextColor = Color.Saturday
  286.           end
  287.         end
  288.         else if BackBox.JulianDay ~= 0 then TextColor = AltColor.Date
  289.         else TextColor = Color.Date
  290.       end
  291.  
  292.       if DoMatchColors ~= 1 then do
  293.         if DoDailyColors == 1 then do
  294.           Select
  295.             when j == Day.Sunday then TextColor = Color.Sunday
  296.             when j == Day.Monday then TextColor = Color.Monday
  297.             when j == Day.Tuesday then TextColor = Color.Tuesday
  298.             when j == Day.Wednesday then TextColor = Color.Wednesday
  299.             when j == Day.Thursday then TextColor = Color.Thursday
  300.             when j == Day.Friday then TextColor = Color.Friday
  301.             when j == Day.Saturday then TextColor = Color.Saturday
  302.           end
  303.         end
  304.         else if BackBox.JulianDay ~= 0 then TextColor = AltColor.Date
  305.         else TextColor = Color.Date
  306.       end
  307.  
  308.       /* Print Day */
  309.       DayType = 'Normal'
  310.       DayID = PrintText(BoxLeft + DateOffset, BoxTop, Date, 'N', TextColor, Width.Date, Day)
  311.       call UpdateBusy(Req, 1)
  312.       if DoDateBox == 1 then do
  313.         call BoxDate(DayID, TextColor)
  314.         call UpdateBusy(Req, 1)
  315.       end
  316.       call DoOptions
  317.       if BackBox.JulianDay == -1 then do
  318.         BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, Background.Weekend, 1)
  319.         call UpdateBusy(Req, 1)
  320.       end
  321.     end
  322.  
  323.     if (i = 5) & (Day = MonthLength.Month) then leave i
  324.   end
  325.   if Day >= MonthLength.Month then leave
  326. end
  327. /**/
  328.  
  329. /***//* Draw grids */
  330. LowRow = i
  331. if LowRow = 3 then LineBottom. = CalTop + BoxHeight*4
  332.  
  333. /* Draw vertical grid */
  334. do i = 0 to 7
  335.   LeftEdge = Margin.Left + BoxWidth*i
  336.   if DoExtended then do
  337.     if LineTop.i > CalTop then do
  338.       call DrawLine(LeftEdge, CalTop, LeftEdge, LineTop.i, 'HL', Line.Extended)
  339.       call UpdateBusy(Req, 1)
  340.     end
  341.     if LineBottom.i < LineBottom.8 then do
  342.       call DrawLine(LeftEdge, LineBottom.i, LeftEdge, LineBottom.8, 'HL', Line.Extended)
  343.       call UpdateBusy(Req, 1)
  344.     end
  345.   end
  346.   call DrawLine(LeftEdge, LineTop.i, LeftEdge, LineBottom.i, 'HL', Line.Grid)
  347.   call UpdateBusy(Req, 1)
  348. end
  349.  
  350. /* Draw horizontal grid */
  351. do i = 0 to min(LowRow + 1, 5)
  352.   TopEdge = CalTop + BoxHeight * i
  353.   if DoExtended then do
  354.     if LineLeft.i > Margin.Left then do
  355.       call DrawLine(Margin.Left, TopEdge, LineLeft.i, TopEdge, 'HL', Line.Extended)
  356.       call UpdateBusy(Req, 1)
  357.     end
  358.     if LineRight.i < CalRight then do
  359.       call DrawLine(LineRight.i, TopEdge, CalRight, TopEdge, 'HL', Line.Extended)
  360.       call UpdateBusy(Req, 1)
  361.     end
  362.   end
  363.   call DrawLine(LineLeft.i, TopEdge, LineRight.i, TopEdge, 'HL', Line.Grid)
  364.   call UpdateBusy(Req, 1)
  365. end
  366. /**/
  367.  
  368. /***//* Draw headers & minicals */
  369. /* Create month/year header */
  370. Text.Top = Margin.Top + ((7*Height.MiniCal) - Height.Header)/HeaderLoc
  371. MonthID = PrintText(Margin.Left, Text.Top , Header, 'N', Color.Header, Width.Header, Month.Month' 'Year)
  372. call UpdateBusy(Req, 1)
  373.  
  374. /* Create weekday titles */
  375. Text.Top = CalTop - (Height.Weekday * 1.15)
  376. Do i = 0 to 6
  377.   WeekdayID.i = PrintText(1, Text.Top, Weekday, 'N', Color.Weekday, Width.Weekday, Day.i)
  378.   call UpdateBusy(Req, 1)
  379. End
  380.  
  381. if App == 'FW' then REDRAW
  382.  
  383. /* Position month/year header */
  384. call CenterText(MonthID, Margin.Left + PrintWidth/2, .9 * (PrintWidth - DoMiniCals * (2 * MiniCalWidth)), 0)
  385. call UpdateBusy(Req, 1)
  386.  
  387. /* Position weekday titles */
  388. MaxWidth = GetMaxWidth('WeekdayID', 6)
  389. if MaxWidth == 0 then MaxWidth = BoxWidth
  390.  
  391. Do i = 0 to 6
  392.   call CenterText(WeekdayID.i, Margin.Left + (i + .5) * BoxWidth, 0, .9 * min(1, BoxWidth/MaxWidth))
  393.   call UpdateBusy(Req, 1)
  394. end
  395.  
  396. if DoMiniCals = 1 then do
  397.   call MiniCalPreCalc(MiniCal, MiniCalWidth)
  398.   call DrawMiniCal(-1, MiniCalWidth, MiniCal)
  399.   call DrawMiniCal(+1, MiniCalWidth, MiniCal)
  400. end
  401. /**/
  402.  
  403. if DoCopyright == 1 then call RightText(PrintText(0, Margin.Top + PrintHeight, 4pt, 'N', Black$, 100, CNotice), Margin.Left + PrintWidth)
  404. if App == 'FW' then SELECTOBJECT
  405. else if App == 'PGS' then SELECTOBJECT NONE
  406.  
  407. call Cleanup
  408. exit
  409. /**/
  410.  
  411. /*********************************************/
  412. /*              Subroutines                  */
  413. /*********************************************/
  414. /***//*******  AddLibraries (AL) Subroutine  ***********/
  415. AddLibraries:
  416.   PortList     = show('P')
  417.   ErrorCount   = 0
  418.   WarningCount = 0
  419.   Req          = 0
  420.   bguiopen     = 0
  421.  
  422.   Storage         = 'RAM:FWC/'
  423.   Notice$         = 'notice'
  424.   Critical$       = 'Critical error'
  425.   See$            = 'see'
  426.   SeeOutput$      = 'see the output above for details'
  427.   ForDetails$     = 'for details'
  428.   ForwardLog$     = 'Forward log file to'
  429.   Unable$         = 'if you are unable to resolve the problem.'
  430.   ForwardContent$ = 'Forward contents of output to'
  431.   SeeShell$       = 'see the shell output for details'
  432.   OK$             = '_OK'
  433.  
  434.   AL_Libs        = 'rexxsupport.library rexxbgui.library bgui.library'
  435.   AL_MinVersions = ' 34.9                4.0             41.10       '
  436.   AL_Offsets     = '-30                -30              -30          '
  437.   do AL_i = 1 to words(AL_Libs)
  438.     AL_Lib        = word(AL_Libs, AL_i)
  439.     AL_MinVersion = word(AL_MinVersions, AL_i)
  440.     AL_Offset     = word(AL_Offsets, AL_i)
  441.     if exists('LIBS:'AL_Lib) then do
  442.       AL_InstalledVersion = libver(AL_Lib)
  443.       if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == 'unknown') then do
  444.         call AddMsg('E', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
  445.       end
  446.       else if pos('rexx', AL_Lib) > 0 then call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
  447.     end
  448.     else call AddMsg('E', AL_lib' is required but could not be found.')
  449.   end
  450.  
  451.   AL_Libs        = 'rexxtricks.library date.library rexxmathlib.library'
  452.   AL_MinVersions = '  0                33.310       38.1               '
  453.   AL_Offsets     = '-30              -492          -30                 '
  454.   AL_Variables   = 'RexxTricks         DateLib      RexxMathLib        '
  455.   do AL_i = 1 to words(AL_Libs)
  456.     AL_Lib        = word(AL_Libs, AL_i)
  457.     AL_MinVersion = word(AL_MinVersions, AL_i)
  458.     AL_Offset     = word(AL_Offsets, AL_i)
  459.     AL_Variable   = word(AL_Variables, AL_i)
  460.     if exists('LIBS:'AL_lib) then do
  461.       AL_InstalledVersion = libver(AL_lib)
  462.       if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == '') then do
  463.         call AddMsg('W', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
  464.         interpret Al_Variable' = 0'
  465.       end
  466.       else do
  467.         call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
  468.         interpret Al_Variable' = 1'
  469.       end
  470.     end
  471.     else interpret Al_Variable' = 0'
  472.   end
  473.   if (DateLib == 1) | (RexxMathLib == 1) then PhaseLib = 1
  474.   else PhaseLib = 0
  475.  
  476.   if ErrorCount > 0 then call Cleanup
  477.   return
  478. /**/
  479.  
  480. /***//*******  AddMsg (AM) Subroutine  ***********/
  481. AddMsg:
  482.   parse arg AM_MsgType, AM_Msg
  483.  
  484.   if AM_MsgType == 'E' then do
  485.     if symbol('ErrorCount') == 'LIT' then ErrorCount = 0
  486.     ErrorCount = ErrorCount + 1
  487.     Error.ErrorCount = AM_Msg
  488.   end
  489.   else do
  490.     if symbol('WarningCount') == 'LIT' then WarningCount = 0
  491.     WarningCount = WarningCount + 1
  492.     Warning.WarningCount = AM_Msg
  493.   end
  494.  
  495.   return 0
  496. /**/
  497.  
  498. /***//*******  AssignHighlight (AH) Subroutine  ***********/
  499. AssignHighlight:
  500.   parse arg AH_Month, AH_Day, AH_Event
  501.  
  502.   if upper(left(AH_Month, 9)) == 'HIGHLIGHT' then do
  503.     AH_Event = strip(substr(AH_Month, pos('=', AH_Month) + 1))
  504.     if right(AH_Event, 2) == '*/' then AH_Event = strip(left(AH_Event, lastpos('/*', AH_Event) - 1))
  505.     AH_Event = substr(AH_Event, 2, Length(AH_Event) - 2)
  506.  
  507.     AH_DateString = DetermineDate1(AH_Month, AH_Day, AH_Event)
  508.     AH_Month = word(AH_DateString, 1)
  509.     AH_Day = word(AH_DateString, 2)
  510.   end
  511.  
  512.   AH_DateString = DetermineDate2(AH_Month, AH_Day)
  513.   AH_Month = word(AH_DateString, 1)
  514.   AH_Day = word(AH_DateString, 2)
  515.  
  516.   if Highlight.AH_Month.AH_Day == '' then Highlight.AH_Month.AH_Day = AH_Event
  517.   else Highlight.AH_Month.AH_Day = Highlight.AH_Month.AH_Day'//'AH_Event
  518.   HighlightCount = HighlightCount + 1
  519.  
  520.   do AH_i = 0 to ImageClass.Count - 1
  521.     if pos(ImageClass.AH_i, upper(AH_Event)) > 0 then do
  522.       Image.AH_Month.AH_Day = AH_i
  523.       ImageCount = ImageCount + 1
  524.       leave
  525.     end
  526.   end
  527.  
  528.   return 0
  529. /**/
  530.  
  531. /***//*******  AssignImage (AI) Subroutine  ***********/
  532. AssignImage:
  533.   parse arg AI_Month, AI_Day, AI_Image
  534.  
  535.   if DoImages ~= 1 then return 0
  536.   if upper(left(AI_Month, 5)) == 'IMAGE' then do
  537.     AI_Image = strip(substr(AI_Month, pos('=', AI_Month) + 1))
  538.     if right(AI_Image, 2) == '*/' then AI_Image = strip(left(AI_Image, lastpos('/*', AI_Image) - 1))
  539.     AI_Image = substr(AI_Image, 2, Length(AI_Image) - 2)
  540.  
  541.     AI_DateString = DetermineDate1(AI_Month, AI_Day, AI_Image)
  542.     AI_Month = word(AI_DateString, 1)
  543.     AI_Day = word(AI_DateString, 2)
  544.   end
  545.  
  546.   parse var AI_Image AI_Image ',' AI_DX ',' AI_DY
  547.   if (pos('/', AI_Image) == 0) & (pos(':', AI_Image) == 0) then AI_Image = ScriptDir'Images/'AI_Image
  548.   AI_DX = strip(AI_DX);if AI_DX == '' then AI_DX = 0
  549.   AI_DY = strip(AI_DY);if AI_DY == '' then AI_DY = 0
  550.   AI_DateString = DetermineDate2(AI_Month, AI_Day)
  551.   AI_Month = word(AI_DateString, 1)
  552.   AI_Day = word(AI_DateString, 2)
  553.  
  554.   if exists(AI_Image) then do
  555.     ICCount = ImageClass.Count
  556.     Image.AI_Month.AI_Day = ICCount
  557.     ImageClass.ICCount = ''
  558.     ImageFile.ICCount = AI_Image
  559.     ImageDX.ICCount = AI_DX
  560.     ImageDY.ICCount = AI_DY
  561.     ImageClass.Count = ImageClass.Count + 1
  562.   end
  563.   return 0
  564. /**/
  565.  
  566. /***//*******  BoxDate (BD) Subroutine  ***********/
  567. BoxDate:
  568.   parse arg BD_ID, BD_DateBoxColor
  569.  
  570.   BD_DateBoxWidth = (DateOffset + GetWidth(BD_ID)) * 1.1
  571.   BD_DateBoxHeight = Height.Date
  572.  
  573.   call DrawBox(BoxLeft, BoxTop, BD_DateBoxWidth, BD_DateBoxHeight, 'HL', BD_DateBoxColor, 0, 0, 0)
  574.   return
  575. /**/
  576.  
  577. /***//*******  CalculateDate (CD) Subroutine  ***********/
  578. CalculateDate:
  579. /* Month    is the month in which the highlight occurs                        */
  580. /* HighDate is the highest (numerical) date on which the highlight will occur */
  581. /* HighDay  is the weekday on which the month starts when HighDate will occur */
  582. /* Event    is the highlight text                                             */
  583.   parse arg CD_Month, CD_HighDay, CD_HighDate, CD_Event
  584.  
  585.   if CD_Month = 13 then CD_Month = Mn - 0
  586.  
  587.   if datatype(CD_HighDate) == 'CHAR' then do
  588.     CD_HighDate = upper(left(CD_HighDate, 1))
  589.     interpret 'CD_EventOffset = Day.'CD_HighDay' - StartDate'
  590.  
  591.     CD_Day  = 1 + CD_EventOffset
  592.     if CD_Day < 1 then CD_Day = CD_Day + 7
  593.  
  594.     do until CD_Day > Monthlength.Month
  595.       CD_WN = trunc((right(DateInfo('J', Year''right(CD_Month, 2, '0')''right(CD_Day, 2, '0'), 'S'), 3) - YearOffset - 1)/7 + 1)
  596.       if CD_HighDate == 'A' then call AssignHighlight(CD_Month, CD_Day, CD_Event)
  597.       else if (CD_HighDate == 'E') & (CD_WN//2 == 0) then call AssignHighlight(CD_Month, CD_Day, CD_Event)
  598.       else if (CD_HighDate == 'O') & (CD_WN//2 == 1) then call AssignHighlight(CD_Month, CD_Day, CD_Event)
  599.       CD_Day = CD_Day + 7
  600.     end
  601.   end
  602.   else do
  603.     interpret 'CD_HighDay = Day.'CD_HighDay
  604.     interpret 'CD_First = Day.'DateInfo('W', Year''right(CD_Month, 2, '0')'01', 'S')
  605.  
  606.     CD_Day = CD_HighDate + (CD_HighDay - CD_First)
  607.     if CD_First < CD_HighDay then CD_Day = CD_Day - 7
  608.     if CD_Event ~= '' then call AssignHighlight(CD_Month, CD_Day, CD_Event)
  609.     else return CD_Day
  610.   end
  611. return 0
  612. /**/
  613.  
  614. /***//*******  CalculateEDate (CED) Subroutine  ***********/
  615. CalculateEDate:
  616. /* DaysPastEaster is the number of days past Easter when the event occurs */
  617. /* Event          is the highlight text                                   */
  618.   parse arg CED_DaysPastEaster, CED_EasterEvent
  619.  
  620.   if DoEaster == 1 then do
  621.     CED_EasterEventDate = DateInfo('S', EasterSerial + CED_DaysPastEaster, 'I')
  622.     CED_EasterEventMonth = strip(substr(CED_EasterEventDate, 5, 2), 'L', '0')
  623.     CED_EasterEventDay = strip(right(CED_EasterEventDate, 2), 'L', '0')
  624.     call AssignHighlight(CED_EasterEventMonth, CED_EasterEventDay, CED_EasterEvent)
  625.   end
  626. return 0
  627. /**/
  628.  
  629. /***//*******  CalculateImage (CI) Subroutine  ***********/
  630. CalculateImage:
  631. /* Month    is the month in which the highlight occurs                        */
  632. /* HighDate is the highest (numerical) date on which the highlight will occur */
  633. /* HighDay  is the weekday on which the month starts when HighDate will occur */
  634. /* Event    is the highlight text                                             */
  635.   parse arg CI_Month, CI_HighDay, CI_HighDate, CI_Image
  636.  
  637.   if DoImages ~= 1 then return 0
  638.  
  639.   if CI_Month = 13 then CI_Month = Mn - 0
  640.  
  641.   if datatype(CI_HighDate) == 'CHAR' then do
  642.     CI_HighDate = upper(left(CI_HighDate, 1))
  643.     interpret 'CI_EventOffset = Day.'CI_HighDay' - StartDate'
  644.  
  645.     CI_Day  = 1 + CI_EventOffset
  646.     if CI_Day < 1 then CI_Day = CI_Day + 7
  647.  
  648.     do until CI_Day > Monthlength.Month
  649.       CI_WN = trunc((right(DateInfo('J', Year''right(CI_Month, 2, '0')''right(CI_Day, 2, '0'), 'S'), 3) - YearOffset - 1)/7 + 1)
  650.       if CI_HighDate == 'A' then call AssignImage(CI_Month, CI_Day, CI_Image)
  651.       else if (CI_HighDate == 'E') & (CI_WN//2 == 0) then call AssignImage(CI_Month, CI_Day, CI_Image)
  652.       else if (CI_HighDate == 'O') & (CI_WN//2 == 1) then call AssignImage(CI_Month, CI_Day, CI_Image)
  653.       CI_Day = CI_Day + 7
  654.     end
  655.   end
  656.   else do
  657.     interpret 'CI_HighDay = Day.'CI_HighDay
  658.     interpret 'CI_First = Day.'DateInfo('W', Year''right(CI_Month, 2, '0')'01', 'S')
  659.  
  660.     CI_Day = CI_HighDate + (CI_HighDay - CI_First)
  661.     if CI_First < CI_HighDay then CI_Day = CI_Day - 7
  662.     if CI_Event ~= '' then call AssignImage(CI_Month, CI_Day, CI_Image)
  663.     else return CI_Day
  664.   end
  665. return 0
  666. /**/
  667.  
  668. /***//*******  CenterText (CT) Subroutine  ***********/
  669. CenterText:
  670.   parse arg CT_id, CT_CenterPoint, CT_MaxWidth, CT_WidthPercent
  671.  
  672.   if App = 'FW' then do
  673.     GETOBJECTCOORDS CT_id; Parse Var result . . CT_Text.Bottom CT_Text.Width CT_Text.Height
  674.     if CT_MaxWidth ~= 0 then CT_Text.Width = min(CT_Text.Width, CT_MaxWidth)
  675.     else CT_Text.Width = CT_Text.Width * CT_WidthPercent
  676.     CT_Text.Left = CT_CenterPoint - CT_Text.Width/2
  677.     SETOBJECTCOORDS CT_id 1 CT_Text.Left CT_Text.Bottom CT_Text.Width CT_Text.Height
  678.   end
  679.   else if App == 'PGS' then do
  680.     GETTEXTOBJ POSITION CT_Text OBJECTID CT_id WINDOW winName
  681.     CT_Text.Width = CT_Text.Right - CT_Text.Left
  682.     if CT_MaxWidth ~= 0 then CT_Text.Width = min(CT_Text.Width, CT_MaxWidth)
  683.     else CT_Text.Width = CT_Text.Width * CT_WidthPercent
  684.     CT_Text.Left = CT_CenterPoint - CT_Text.Width/2
  685.     EDITTEXTOBJ POSITION CT_Text.Left CT_Text.Top (CT_Text.Left + CT_Text.Width) CT_Text.Bottom OBJECTID CT_id WINDOW winName
  686.   end
  687.   return
  688. /**/
  689.  
  690. /***//*******  CheckShanghai (CS) Subroutine  ***********/
  691. CheckShanghai:
  692.   if RexxTricks == 1 then do
  693.     if DoShanghai ~= 0 then PubScreen = AppScreen
  694.     else PubScreen = DefPubScreen
  695.   end
  696.   return
  697. /**/
  698.  
  699. /***//*******  Cleanup () Subroutine  ***********/
  700. Cleanup:
  701.   signal off syntax
  702.   call close('DataFile')
  703.  
  704.   if Req ~= 0 then call bguiwinclose(Req)
  705.   if VariablesSet == 1 then do
  706.     interpret UserPrefs
  707.     if App == 'FW' then do
  708.       SELECTOBJECT
  709.       VIEW FinalView
  710.       if upper(DecimalFormat) = 'COMMA' then DOCITEMPREFS DECIMAL Comma
  711.     end
  712.   end
  713.   if App == 'PGS' then do
  714.     LOCKINTERFACE FALSE
  715.     LOADSETTINGS default
  716.     REFRESH ON
  717.     REFRESHWINDOW
  718.     DISPLAY SCALE FinalView
  719.     REVEALWINDOW ALL
  720.   end
  721.  
  722.   if (ErrorCount == 0) & (CalType == 1) & (LaunchM ~= '') then interpret LaunchM
  723.   if (ErrorCount == 0) & (CalType == 2) & (LaunchY ~= '') then interpret LaunchY
  724.  
  725.   LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  726.   if LogOpen == 1 then OutType = 'File'
  727.   if ((WarningCount > 0) | (ErrorCount > 0)) & (LogOpen == 0) then do
  728.     LogOpen = 1
  729.     call open('FWCLog', 'CON:10/10/500/300/FWCalendar.rexx Message/WAIT/CLOSE')
  730.     OutType = 'CON'
  731.   end
  732.  
  733.   if LogOpen == 1 then do
  734.     call writeln('FWCLog', '      Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
  735.     call writeln('FWCLog', 'Application: 'PgmVersion)
  736.     call writeln('FWCLog', 'Current Dir: 'CurrentDir)
  737.     call writeln('FWCLog', ' Script Dir: 'ScriptDir)
  738.     call writeln('FWCLog', '       Host: 'CallHost)
  739.     call writeln('FWCLog', '   Calendar: 'Calendar||'0a'x)
  740.   end
  741.  
  742.   if (ErrorCount > 0) | (WarningCount > 0) then do
  743.     do i = 1 to ErrorCount
  744.       call writeln('FWCLog', Error.i)
  745.     end
  746.  
  747.     do i = 1 to WarningCount
  748.       call writeln('FWCLog', Warning.i)
  749.     end
  750.  
  751.     if (exists(PrefsFile)) & (word(statef(PrefsFile), 2) > 2) then do
  752.       call writeln('FWCLog', '0a'x||' -- 'PrefsFile' -- ')
  753.       if open('DataFile', PrefsFile) then do
  754.         do until eof('DataFile')
  755.           Ln = ReadLn('DataFile')
  756.           if pos('End Pass One', Ln) > 0 then
  757.             if (SettingHighlights ~= 1) & (ListHighlightData ~= 1) then leave
  758.           call writeln('FWCLog', Ln)
  759.         end
  760.         call close('DataFile')
  761.       end
  762.     end
  763.     if (exists(ScriptDir''ChangesFile)) & (word(statef(ScriptDir''ChangesFile), 2) > 2) then do
  764.       call writeln('FWCLog', '0a'x||' -- 'ScriptDir''ChangesFile' -- ')
  765.       call open('DataFile', ScriptDir''ChangesFile)
  766.         do until eof('DataFile')
  767.           call writeln('FWCLog', ReadLn('DataFile'))
  768.         end
  769.       call close('DataFile')
  770.     end
  771.  
  772.     if ErrorCount > 0 then ErrorType = Critical$
  773.     else ErrorType = Noncritical$
  774.     FileMsg = ErrorType' ... 'See$' 'Storage'FWCLog.txt 'ForDetails$'.'||'0a'x||ForwardLog$': Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  775.     Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  776.     ConCon  = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  777.     if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
  778.     if (OutType == 'File') & (bguiopen == 0) then do
  779.       call open('CON', 'CON:10/10/500/300/FWCalendar notice/WAIT/CLOSE')
  780.         call writeln('CON', FileMsg)
  781.       call close('CON')
  782.     end
  783.     if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
  784.     if (OutType == 'CON') & (bguiopen == 0) then call Writeln('FWCLog', '0a'x||ConCon)
  785.   end
  786.   else do
  787.     if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
  788.   end
  789.  
  790.   address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
  791.   address command 'delete >NIL: 'Storage'FWCTemp quiet'
  792.   call close('FWCLog')
  793.   if bguiopen = 1 then call bguiclose()
  794.  
  795.   exit
  796. /**/
  797.  
  798. /***//*******  ConvertJ (CJ) Subroutine  ***********/
  799. /* Routine to convert from 'J' & 'F' to normal dates obtained from the Sky & Telescope */
  800. /* web site. The basic program from which the following was derived originally    */
  801. /* appeared in Astronomical Computing, Sky & Telescope, May, 1984                 */
  802. ConvertJ:
  803.   parse arg CJ_F, CJ_J
  804.  
  805.   CJ_F = CJ_F + 0.5
  806.   if CJ_F >= 1 then do
  807.     CJ_F = CJ_F - 1
  808.     CJ_J = CJ_J + 1
  809.   end
  810.   CJ_A1 = trunc((CJ_J / 36524.25) - 51.12264)
  811.   CJ_A = CJ_J + 1 + CJ_A1 - trunc(CJ_A1 / 4)
  812.   CJ_B = CJ_A + 1524
  813.   CJ_C = trunc((CJ_B / 365.25) - 0.3343)
  814.   CJ_D = trunc(365.25 * CJ_C)
  815.   CJ_E = trunc((CJ_B - CJ_D) / 30.61)
  816.   CJ_D = CJ_B - CJ_D - trunc(30.61 * CJ_E) + CJ_F
  817.   CJ_M = CJ_E - 1
  818.   CJ_Y = CJ_C - 4716
  819.   IF CJ_E > 13.5 then CJ_M = CJ_M - 12
  820.   IF CJ_M < 2.5 then CJ_Y = CJ_Y + 1
  821.   CJ_Day = trunc(CJ_D)
  822.  
  823.   return right(CJ_Y, 4, '0')' 'right(CJ_M, 2, '0')' 'right(CJ_Day, 2, '0')' 'CJ_D - CJ_Day
  824. /**/
  825.  
  826. /***//*******  ControlMX (CM) Subroutine  ***********/
  827. ControlMX:
  828.   parse arg CM_Group
  829.  
  830.   pos = pos.CM_Group
  831.  
  832.   do CM_i = 0 to 1
  833.     option = Option.pos
  834.     if option ~= 0 then do
  835.       do dst = 0 to GroupCount
  836.         if CM_Group = dst then iterate
  837.         interpret 'call bguiset('grp.dst',winID,'Action.CM_i','option')'
  838.  
  839.         if ((Do.option == 'Julian') | (Do.option == 'JulianLeft')) & ((CM_i = 1) | ((CM_i = 0) & (ActiveJulian == 1))) then
  840.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.BothJ')'
  841.         if Do.option = 'BothJ' then do
  842.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Julian')'
  843.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.JulianLeft')'
  844.         end
  845.  
  846.         if ((Do.option == 'Sunrise') | (Do.option == 'Sunset')) & ((CM_i = 1) | ((CM_i = 0) & (ActiveSunCalc == 1))) then
  847.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.BothS')'
  848.         if Do.option = 'BothS' then do
  849.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Sunrise')'
  850.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Sunset')'
  851.         end
  852.  
  853.       end
  854.     end
  855.     interpret 'Option.'pos' = bguiget('grp.CM_Group', MX_Active)'
  856.   end
  857.  
  858.   if (Do.option == 'Julian') | (Do.option == 'JulianLeft') then ActiveJulian.CM_Group = 1
  859.   else ActiveJulian.CM_Group = 0
  860.   if (Do.option == 'Sunrise') | (Do.option == 'Sunset') then ActiveSunCalc.CM_Group = 1
  861.   else ActiveSunCalc.CM_Group = 0
  862.  
  863.   ActiveJulian = 0
  864.   ActiveSunCalc = 0
  865.   do grp = 0 to GroupCount
  866.     ActiveJulian = ActiveJulian + ActiveJulian.grp
  867.     ActiveSunCalc = ActiveSunCalc + ActiveSunCalc.grp
  868.   end
  869.  
  870.   if ActiveJulian == 1 then
  871.     do grp = 0 to GroupCount
  872.       if ActiveJulian.grp == 1 then interpret 'call bguiset('grp.grp',winID,MX_EnableButton,'MXPos.BothJ')'
  873.     end
  874.  
  875.   if ActiveSunCalc == 1 then
  876.     do grp = 0 to GroupCount
  877.       if ActiveSunCalc.grp == 1 then interpret 'call bguiset('grp.grp',winID,MX_EnableButton,'MXPos.BothS')'
  878.     end
  879.  
  880.   return
  881. /**/
  882.  
  883. /***//*******  CreateDataFile (CD) Subroutine  ***********/
  884. CreateDataFile:
  885.   CD_VarCount = 0
  886.   CD_Progress = -1
  887.   if App == 'FW' then do
  888.     GETSECTIONSETUP Top Bottom Inside Outside
  889.     parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right
  890.   end
  891.   else if App == 'PGS' then do
  892.     Margin.Top    = 0.5
  893.     Margin.Bottom = 0.5
  894.     Margin.Left   = 0.5
  895.     Margin.Right  = 0.5
  896.   end
  897.  
  898.   if (~exists(ScriptDir''ChangesFile)) | (word(statef(ScriptDir''ChangesFile), 2) < 2) then do
  899.     if open('DataFile', ScriptDir''ChangesFile, 'W') then do
  900.       call TranslationStrings
  901.       call open('Temp', FullCallPath)
  902.         FileOffset = 120000
  903.         call seek('Temp', FileOffset, 'B')
  904.         do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  905.           PrevOffset = FileOffset
  906.           Chunk = readch('Temp', 65535)
  907.           EndPos = pos('VarList:'||'0a'x, Chunk)
  908.           if EndPos == 0 then FileOffset = seek('Temp', -10, 'C')
  909.         end
  910.         call seek('Temp', FileOffset + EndPos + 8, 'B')
  911.         DefaultVariables = readch('Temp', 65535)
  912.       call close('Temp')
  913.       call openv('DefaultVariables')
  914.         do forever
  915.           CD_VarLine = strip(readvln('DefaultVariables'))
  916.           if CD_VarLine == 'return' then leave
  917.           if CD_VarLine == '' then iterate
  918.           if left(CD_VarLine, 7) ~= 'Margin.' then interpret CD_VarLine
  919.           CD_Var = word(CD_VarLine, 1)
  920.           CD_Var.CD_VarCount = CD_Var
  921.           if (datatype(value(CD_Var.CD_VarCount)) == 'CHAR') then CD_VarLine.CD_VarCount = CD_Var.CD_VarCount" = '"Value(CD_Var.CD_VarCount)"'"
  922.           else CD_VarLine.CD_VarCount = CD_Var.CD_VarCount' = 'Value(CD_Var.CD_VarCount)
  923.           CD_VarCount = CD_VarCount + 1
  924.         end
  925.       call closev('DefaultVariables')
  926.  
  927.       if (PrefsFile ~= 'Default') & (exists(PrefsFile)) then do
  928.         if open('UserFile', PrefsFile) then do
  929.           UserFile = readch('UserFile', 65535)
  930.           call close('UserFile')
  931.           call openv('UserFile')
  932.             do until eofv('UserFile')
  933.               CD_Progress = -CD_Progress
  934.               call UpdateBusy(Req, CD_Progress)
  935.               CD_VarLine = strip(ReadvLn('UserFile'))
  936.               CD_VarName = upper(strip(word(CD_VarLine, 1)))
  937.               if left(CD_VarLine, 15) == '/* End Pass One' then leave
  938.               if (right(CD_VarName, 1) == '$') |,
  939.                  (left(CD_VarLine, 2) == '/*') |,
  940.                  (CD_VarLine == '') then iterate
  941.               CD_MemberID = MemberID(CD_VarName, 'CD_Var', CD_VarCount)
  942.               if CD_MemberID >= 0 then CD_VarLine.CD_MemberID = CD_VarLine
  943.               else do
  944.                 CD_Var.CD_VarCount = CD_VarName
  945.                 CD_VarLine.CD_VarCount = CD_VarLine
  946.                 CD_VarCount = CD_VarCount + 1
  947.               end
  948.             end
  949.           call closev('UserFile')
  950.         end
  951.       end
  952.       call writeln('DataFile', 'Dataversion 'word(sourceline(4), 3))
  953.       call writeln('DataFile', "PrefsFile = '"PrefsFile"'")
  954.       call writeln('DataFile', "Cancel$ = '"Cancel$"'")
  955.       call writeln('DataFile', "PleaseWait$ = '"PleaseWait$"'")
  956.       call writeln('DataFile', "PrepReq$ = '"PrepReq$"'")
  957.       do CD_i = 0 to CD_VarCount - 1
  958.         call writeln('DataFile', CD_VarLine.CD_i)
  959.       end
  960.       call close('DataFile')
  961.       if sign(CD_Progress) == 1 then call UpdateBusy(Req, -CD_Progress)
  962.     end
  963.     else do
  964.       call AddMsg('E', 'Unable to create 'ScriptDir''ChangesFile)
  965.       call Cleanup
  966.     end
  967.   end
  968.  
  969.   return
  970. /**/
  971.  
  972. /***//*******  DateInfo (PROCEDURE) Subroutine  ***********/
  973. DateInfo: PROCEDURE
  974.   /* DateInfo('I', '19780101', 'S') = 2443510  */
  975.   /* Date('I', '19780101', 'S') = 0            */
  976.   /* Option 'C' returns days since Jan 1, xx00 */
  977.   parse arg Option, Date, Format
  978.  
  979.   if Option == '' then Option = 'N'
  980.   if Date == '' then do
  981.     Date = Date('S')
  982.     Format = 'S'
  983.   end
  984.  
  985.   Option = upper(left(Option, 1))
  986.   Format = upper(left(Format, 1))
  987.   if (Format == 'I') | (Format = '') then do
  988.     Format = 'I'
  989.  
  990.     /* Routine to convert from a serial date to year/month/day obtained from the        */
  991.     /* Sky & Telescope web site. The basic program from which the following was         */
  992.     /* derived originally appeared in Astronomical Computing, Sky & Telescope,May, 1984 */
  993.     A1 = trunc((Date / 36524.25) - 51.12264)
  994.     A = Date + 1 + A1 - trunc(A1 / 4)
  995.     B = A + 1524
  996.     C = trunc((B / 365.25) - 0.3343)
  997.     D = trunc(365.25 * C)
  998.     E = trunc((B - D) / 30.61)
  999.     D = B - D - trunc(30.61 * E)
  1000.     Month = E - 1
  1001.     Year = C - 4716
  1002.     IF E > 13.5 then Month = Month - 12
  1003.     IF Month < 2.5 then Year = Year + 1
  1004.     Day = trunc(D)
  1005.     J = Date
  1006.   end
  1007.   else do
  1008.     Year  = left(Date, 4) - 0
  1009.     Month = substr(Date, 5, 2) - 0
  1010.     Day   = right(Date, 2) - 0
  1011.     /* The following two lines are modified from PerpetualCalendar.bas that */
  1012.     /* appeared in Astronomical Computing, Sky & Telescope, July, 1985      */
  1013.     Temp = 0; if Month <= 2 then Temp = -1
  1014.     J = 367*Year-trunc(7*(Year+trunc((Month + 9)/12))/4)+trunc(275*Month/9)+1721031-trunc(3*(trunc((Year+Temp)/100)+1)/4) + Day - 2
  1015.   end
  1016.  
  1017.   select
  1018.     when Option == 'B' then do
  1019.       return J - 1721060
  1020.     end
  1021.     when Option == 'C' then do
  1022.       return J + 2 - DateInfo('I', left(right(Year, 4, '0'), 2)'000101', 'S')
  1023.     end
  1024.     when (Option == 'D') | (Option == 'J') then do
  1025.       DayCount = 0
  1026.       MonthLength.1    = 31
  1027.       MonthLength.2    = 28
  1028.       MonthLength.3    = 31
  1029.       MonthLength.4    = 30
  1030.       MonthLength.5    = 31
  1031.       MonthLength.6    = 30
  1032.       MonthLength.7    = 31
  1033.       MonthLength.8    = 31
  1034.       MonthLength.9    = 30
  1035.       MonthLength.10   = 31
  1036.       MonthLength.11   = 30
  1037.       MonthLength.12   = 31
  1038.       if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2 = 29
  1039.  
  1040.       do I = (Month - 1) to 1 by -1
  1041.         DayCount = DayCount + MonthLength.I
  1042.       end
  1043.       if Option == 'D' then return DayCount + Day
  1044.       else return right(Year, 2)''right(DayCount + Day, 3, '0')
  1045.     end
  1046.     when Option == 'E' then do
  1047.       return right(Day, 2, '0')'/'right(Month, 2, '0')'/'right(Year, 2, '0')
  1048.     end
  1049.     when Option == 'I' then return J
  1050.     when (Option == 'M') | (Option == 'N') then do
  1051.       Select
  1052.         when Month ==  1 then Month = 'January'
  1053.         when Month ==  2 then Month = 'February'
  1054.         when Month ==  3 then Month = 'March'
  1055.         when Month ==  4 then Month = 'April'
  1056.         when Month ==  5 then Month = 'May'
  1057.         when Month ==  6 then Month = 'June'
  1058.         when Month ==  7 then Month = 'July'
  1059.         when Month ==  8 then Month = 'August'
  1060.         when Month ==  9 then Month = 'September'
  1061.         when Month == 10 then Month = 'October'
  1062.         when Month == 11 then Month = 'November'
  1063.         when Month == 12 then Month = 'December'
  1064.       end
  1065.       if Option == 'M' then return Month
  1066.       else return right(Day, 2, '0')' 'left(Month, 3)' 'Year
  1067.     end
  1068.     when Option == 'O' then return right(Year, 2, '0')'/'right(Month, 2, '0')'/'right(Day, 2, '0')
  1069.     when Option == 'S' then return right(Year, 4, '0')''right(Month, 2, '0')''right(Day, 2, '0')
  1070.     when Option == 'U' then return right(Month, 2, '0')'/'right(Day, 2, '0')'/'right(Year, 2, '0')
  1071.     when Option == 'W' then do
  1072.       J = J + 1
  1073.       Weekday = J - 7 * trunc(J / 7)
  1074.       Select
  1075.         when Weekday == 0 then return 'Sunday'
  1076.         when Weekday == 1 then return 'Monday'
  1077.         when Weekday == 2 then return 'Tuesday'
  1078.         when Weekday == 3 then return 'Wednesday'
  1079.         when Weekday == 4 then return 'Thursday'
  1080.         when Weekday == 5 then return 'Friday'
  1081.         when Weekday == 6 then return 'Saturday'
  1082.       end
  1083.     end
  1084.     otherwise return 0
  1085.   end
  1086. /**/
  1087.  
  1088. /***//*******  DetermineDate1 (DD1) Subroutine  ***********/
  1089. DetermineDate1:
  1090.   parse arg DD1_Month, DD1_Day, DD1_Event
  1091.  
  1092.   DD1_Ln = DD1_Month
  1093.   DD1_Month = pos('.', DD1_Ln) + 1
  1094.   DD1_Day   = pos('.', DD1_Ln, DD1_Month) + 1
  1095.   DD1_Event = pos('=', DD1_Ln) + 1
  1096.   DD1_Month = substr(DD1_Ln, DD1_Month, DD1_Day - DD1_Month - 1)
  1097.   if DD1_Month == '13' then DD1_Month = Mn - 0
  1098.   DD1_Day   = upper(strip(substr(DD1_Ln, DD1_Day, DD1_Event - DD1_Day - 1)))
  1099.   if left(DD1_Day, 2) = '32' then DD1_Day = overlay(MonthLength.DD1_Month, DD1_Day)
  1100.   return DD1_Month' 'DD1_Day
  1101. /**/
  1102.  
  1103. /***//*******  DetermineDate2 (DD2) Subroutine  ***********/
  1104. DetermineDate2:
  1105.   parse arg DD2_Month, DD2_Day
  1106.  
  1107.   DD2_DateString = Year''right(DD2_Month, 2, '0')''right(strip(DD2_Day, 'T', 'PN'), 2, '0')
  1108.   DD2_Weekday = DateInfo('W', DD2_DateString, 'S')
  1109.   if (right(DD2_Day, 1) == 'N') & (DD2_Weekday == 'Saturday') then do
  1110.     DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') + 2), 'I')
  1111.     DD2_Month = substr(DD2_NewDay, 5, 2) - 0
  1112.     DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  1113.   end
  1114.   else if (right(DD2_Day, 1) == 'P') & (DD2_Weekday == 'Saturday') then do
  1115.     DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') - 1), 'I')
  1116.     DD2_Month = substr(DD2_NewDay, 5, 2) - 0
  1117.     DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  1118.   end
  1119.   else if (right(DD2_Day, 1) == 'N') & (DD2_Weekday == 'Sunday') then do
  1120.     DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') + 1), 'I')
  1121.     DD2_Month = substr(DD2_NewDay, 5, 2) - 0
  1122.     DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  1123.   end
  1124.   else if (right(DD2_Day, 1) == 'P') & (DD2_Weekday == 'Sunday') then do
  1125.     DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') - 2), 'I')
  1126.     DD2_Month = substr(DD2_NewDay, 5, 2) - 0
  1127.     DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  1128.   end
  1129.   DD2_Day = strip(DD2_Day, 'T', 'PN')
  1130.  
  1131.   return DD2_Month' 'DD2_Day
  1132. /**/
  1133.  
  1134. /***//*******  DetermineHost () Subroutine  ***********/
  1135. DetermineHost:
  1136.   parse source . . . FullCallPath . CallHost
  1137.   CallHost = strip(CallHost)
  1138.   ScriptDir = PathPart(FullCallPath)
  1139.  
  1140.   CurrentDir = upper(Pragma('D'))
  1141.   if right(CurrentDir, 1) ~= ':' then CurrentDir = CurrentDir'/'
  1142.  
  1143.   owner = ReadEnv('Owner')
  1144.   if (pos('FINALWRITER', CurrentDir) > 0) | (left(CallHost, 6) == 'FINALW') then do
  1145.     App     = 'FW'
  1146.     AppName = 'FINALWRITER'
  1147.     if CallHost == 'REXX' then HostPort = substr(PortList, pos('FINALW.', PortList), 8)
  1148.     else HostPort = CallHost
  1149.     address value HostPort
  1150.     if owner == 'rgoertz' then do
  1151.       if CallHost == 'REXX' then CLEARDOC FORCE
  1152.       else do
  1153.         CLEARDOC
  1154.         if result == 1 then exit
  1155.       end
  1156.     end
  1157.     else do
  1158.       CLEARDOC
  1159.       if result == 1 then exit
  1160.     end
  1161.  
  1162.     GETDOCITEMPREFS Decimal; DecimalFormat = result
  1163.     DOCITEMPREFS Decimal Period
  1164.   end
  1165.   else if (pos('PAGESTREAM', CurrentDir) > 0) | (CallHost == 'PAGESTREAM') then do
  1166.     App     = 'PGS'
  1167.     AppName = 'PAGESTREAM'
  1168.     HostPort = 'PAGESTREAM'
  1169.   end
  1170.   else do
  1171.     call AddMsg('E', 'Unable to determine host!')
  1172.     call Cleanup
  1173.   end
  1174.  
  1175.   AppScreen = ''
  1176.   DefPubScreen = ''
  1177.   if RexxTricks == 1 then do
  1178.     if (pubscreenlist('ScreenList') > 0) then do
  1179.       do i = 1 to ScreenList.0
  1180.         if pos(AppName, upper(ScreenList.i)) > 0 then do
  1181.           AppScreen = ScreenList.i
  1182.           leave
  1183.         end
  1184.       end
  1185.     end
  1186.   end
  1187.  
  1188.   return HostPort
  1189. /**/
  1190.  
  1191. /***//*******  DoOptions (DO) Subroutine  ***********/
  1192. DoOptions:
  1193.   DO_PrevDay = Day - 7
  1194.  
  1195.   if (DayType == 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Extended
  1196.   else if (DayType == 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Extended
  1197.  
  1198.   /***//* DoJulian & DoJulianLeft */
  1199.   if (DoJulian ~= 0) | (DoJulianLeft ~= 0) then do
  1200.     DO_JDay = right(DateInfo('J', JulianDay, 'I'), 3)
  1201.     if (Day <= 0) & (PrevMonth = 12) then DO_JDayLeft = right(365 + PrevLeapYear - DO_JDay, 3, '0')
  1202.     else DO_JDayLeft = right(365 + LeapYear - DO_JDay, 3, '0')
  1203.  
  1204.     if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Julian
  1205.     else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Julian
  1206.  
  1207.     if DoJulian ~= 0 then do
  1208.       DO_Text2Print = Text.Julian''DO_JDay
  1209.       if DoJulianLeft == DoJulian then DO_Text2Print = DO_Text2Print'/'DO_JDayLeft
  1210.       call UpdateBusy(Req, 1)
  1211.       JID.Day = PrintOption(DoJulian)
  1212.       if (i = 5) & (left(DoJulian, 1) ~= 'T') then call Move(JID.DO_PrevDay, 0, -BoxHeight / 2)
  1213.     end
  1214.  
  1215.     if (DoJulianLeft ~= 0) & (DoJulianLeft ~= DoJulian) then do
  1216.       DO_Text2Print = DO_JDayLeft
  1217.       call UpdateBusy(Req, 1)
  1218.       JIDL.Day = PrintOption(DoJulianLeft)
  1219.       if (i = 5) & (left(DoJulianLeft, 1) ~= 'T') then call Move(JIDL.DO_PrevDay, 0, -BoxHeight / 2)
  1220.     end
  1221.   end
  1222.   /**/
  1223.  
  1224. /***//* DoSunrise & DoSunset */
  1225.   if (DoSunRise ~= 0) | (DoSunSet ~= 0) then do
  1226.     SRSS$ = GetSRSS(JulianDay)
  1227.  
  1228.     if DoSunRise ~= 0 then do
  1229.       if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Sunrise
  1230.       else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Sunrise
  1231.       DO_Text2Print = Text.Sunrise''word(SRSS$, 1)
  1232.       if DoSunSet == DoSunRise then DO_Text2Print = DO_Text2Print'/'word(SRSS$, 3)
  1233.       call UpdateBusy(Req, 1)
  1234.       SRID.Day = PrintOption(DoSunRise)
  1235.       if (i = 5) & (left(DoSunRise, 1) ~= 'T') then call Move(SRID.DO_PrevDay, 0, -BoxHeight / 2)
  1236.     end
  1237.  
  1238.     if (DoSunSet ~= 0) & (DoSunSet ~= DoSunRise) then do
  1239.       if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Sunset
  1240.       else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Sunset
  1241.       DO_Text2Print = Text.Sunset''word(SRSS$, 3)
  1242.       call UpdateBusy(Req, 1)
  1243.       SSID.Day = PrintOption(DoSunSet)
  1244.       if (i = 5) & (left(DoSunSet, 1) ~= 'T') then call Move(SSID.DO_PrevDay, 0, -BoxHeight / 2)
  1245.     end
  1246.   end
  1247.   /**/
  1248.  
  1249. /***//* DoWeekNumber */
  1250.   if (DoWeekNumber ~= 0) & (j = 0) then do
  1251.     if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.WeekNumber
  1252.     else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.WeekNumber
  1253.     DO_WN = trunc((right(DateInfo('J', JulianDay, 'I'), 3) - YearOffset - 1)/7 + 1)
  1254.     DO_Text2Print = Text.WeekNumber''DO_WN
  1255.     call UpdateBusy(Req, 1)
  1256.     WNID.Day = PrintOption(DoWeekNumber)
  1257.     if (i = 5) & (left(DoWeekNumber, 1) ~= 'T') then call Move(WNID.DO_PrevDay, 0, -BoxHeight / 2)
  1258.   end
  1259.   /**/
  1260.  
  1261.   /***//* DoImages */
  1262.   if DoImages == 1 then do
  1263.     if Image.Month.Day ~= '' then do
  1264.       ImageNumber = Image.Month.Day
  1265.       ImageDX = ImageDX.ImageNumber
  1266.       ImageDY = ImageDY.ImageNumber
  1267.       if ImageType.ImageNumber == '' then do
  1268.         DO_Cmd = Storage''GfxApp' >ENV:FWCTemp '
  1269.         DO_InsertPos = pos('%s', GfxCmd)
  1270.         DO_Cmd = DO_Cmd''left(GfxCmd, DO_InsertPos - 1)''ImageFile.ImageNumber''substr(GfxCmd, DO_InsertPos + 2)
  1271.         address command DO_Cmd
  1272.         DO_Template = GfxTemplate
  1273.         DO_InfoLine = ReadEnv('FWCTemp')
  1274.         if DO_InfoLine ~= '' then do
  1275.           interpret "parse var DO_InfoLine "DO_Template
  1276.           DO_ImageType = upper(strip(ImgDT))
  1277.           DO_Width = strip(ImgWidth)
  1278.           DO_Height = strip(ImgHeight)
  1279.           if (datatype(DO_ImageType) ~= 'CHAR') | (datatype(DO_Width) ~= 'NUM') | (datatype(DO_Height) ~= 'NUM') then do
  1280.             call AddMsg('W', DO_InfoLine)
  1281.             Image.Month.Day = ''
  1282.           end
  1283.           else do
  1284.             ImageType.ImageNumber = DO_ImageType
  1285.             if DO_ImageType ~= 'POST' then do
  1286.               ImageWidth.ImageNumber = DO_Width / 72
  1287.               ImageHeight.ImageNumber = DO_Height / 72
  1288.               if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
  1289.                 EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
  1290.                 ImageWidth.ImageNumber  = ImageWidth.ImageNumber / EnlFactor
  1291.                 ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
  1292.               end
  1293.             end
  1294.           end
  1295.         end
  1296.       end
  1297.  
  1298.       call UpdateBusy(Req, 1)
  1299.  
  1300.       if ImageType.ImageNumber ~= '' then do
  1301.         if App == 'FW' then do
  1302.           if ImageWidth.ImageNumber == 0 then do
  1303.             INSERTIMAGE ImageFile.ImageNumber POSITION 1 '-1' '-1' '-1' '-1'
  1304.             ImageID.Day = result
  1305.             GETOBJECTCOORDS ImageID.Day
  1306.             parse var result . . . ImageWidth.ImageNumber ImageHeight.ImageNumber
  1307.             if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
  1308.               EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
  1309.               ImageWidth.ImageNumber  = ImageWidth.ImageNumber / EnlFactor
  1310.               ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
  1311.             end
  1312.             DELETEOBJECT ImageID.Day
  1313.           end
  1314.           Image.Left = BoxLeft + (BoxWidth - ImageWidth.ImageNumber)/2 + ImageDX
  1315.           Image.Top  = BoxTop + (BHeight - ImageHeight.ImageNumber)/2 + ImageDY
  1316.           INSERTIMAGE ImageFile.ImageNumber POSITION 1 Image.Left Image.Top ImageWidth.ImageNumber ImageHeight.ImageNumber
  1317.           ImageID.Day = result
  1318.           OBJECTTOBACK ImageID.Day
  1319.           if BackBox.JulianDay ~= 0 then OBJECTTOBACK BackBox.JulianDay
  1320.         end
  1321.         else if App == 'PGS' then do
  1322.           DO_ImgType = ImageType.ImageNumber
  1323.           if PGSFilter.DO_ImgType == '' then PGSFilter.DO_ImgType = DO_ImgType
  1324.           if ImageWidth.ImageNumber == 0 then do
  1325.             PLACEGRAPHIC FILE ImageFile.ImageNumber FILTER PGSFilter.DO_ImgType WINDOW winName
  1326.             ImageID.Day = result
  1327.             if ImageType.ImageNumber == 'POST' then GETDRAWING POSITION Image OBJECTID ImageID.Day WINDOW winName
  1328.             else GETPICTURE POSITION Image OBJECTID ImageID.Day WINDOW winName
  1329.             DELETEOBJECT OBJECTID ImageID.Day WINDOW winName
  1330.             ImageWidth.ImageNumber = Image.Right - Image.Left
  1331.             ImageHeight.ImageNumber = Image.Bottom - Image.Top
  1332.             if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
  1333.               EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
  1334.               ImageWidth.ImageNumber  = ImageWidth.ImageNumber / EnlFactor
  1335.               ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
  1336.             end
  1337.           end
  1338.           Image.Left = BoxLeft + (BoxWidth - ImageWidth.ImageNumber)/2 + ImageDX
  1339.           Image.Top  = BoxTop + (BHeight - ImageHeight.ImageNumber)/2 + ImageDY
  1340.           PLACEGRAPHIC FILE ImageFile.ImageNumber FILTER PGSFilter.DO_ImgType AT Image.Left Image.Top WINDOW winName
  1341.           ImageID.Day = result
  1342.           if ImageType.ImageNumber == 'POST' then EDITDRAWING POSITION Image.Left Image.Top (Image.Left + ImageWidth.ImageNumber) (Image.Top + ImageHeight.ImageNumber) OBJECTID ImageID.Day WINDOW winName
  1343.           else EDITPICTURE POSITION Image.Left Image.Top (Image.Left + ImageWidth.ImageNumber) (Image.Top + ImageHeight.ImageNumber) OBJECTID ImageID.Day WINDOW winName
  1344.           SENDTOBACK OBJECTID ImageID.Day WINDOW winName
  1345.           if BackBox.JulianDay ~= 0 then SENDTOBACK OBJECTID BackBox.JulianDay WINDOW winName
  1346.         end
  1347.       end
  1348.     end
  1349.  
  1350.     if (i = 5) & (Image.Month.DO_PrevDay ~= '') then do
  1351.       ImageNumber = Image.Month.DO_PrevDay
  1352.       if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
  1353.         EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
  1354.         Image.Width  = ImageWidth.ImageNumber/EnlFactor
  1355.         Image.Height = ImageHeight.ImageNumber/EnlFactor
  1356.       end
  1357.       else do
  1358.         Image.Width = ImageWidth.ImageNumber
  1359.         Image.Height = ImageHeight.ImageNumber
  1360.       end
  1361.       Image.Left = BoxLeft + (BoxWidth - Image.Width)/2
  1362.       Image.Top  = BoxTop - BHeight + (BHeight - Image.Height)/2
  1363.  
  1364.       if App == 'FW' then do
  1365.         SETOBJECTCOORDS ImageID.DO_PrevDay 1 Image.Left Image.Top Image.Width Image.Height
  1366.         OBJECTTOBACK ImageID.DO_PrevDay
  1367.       end
  1368.       else if App == 'PGS' then do
  1369.         if ImageType.ImageNumber == 'POST' then EDITDRAWING POSITION Image.Left Image.Top (Image.Left + Image.Width) (Image.Top + Image.Height) ADJUST SCALECONTENT OBJECTID ImageID.DO_PrevDay WINDOW winName
  1370.         else EDITPICTURE POSITION Image.Left Image.Top (Image.Left + Image.Width) (Image.Top + Image.Height) OBJECTID ImageID.DO_PrevDay WINDOW winName
  1371.         SENDTOBACK OBJECTID ImageID.DO_PrevDay WINDOW winName
  1372.       end
  1373.     end
  1374.   end
  1375.   /**/
  1376.  
  1377. /***//* DoPhases */
  1378.   if Day < 1 then do
  1379.     DO_PrintColor = Color.Extended
  1380.     DO_MoonDay = PrintDay
  1381.     DO_MoonMonth = PrevMonth
  1382.     DO_MoonYear = PrevYear
  1383.   end
  1384.   else if Day > MonthLength.Month then do
  1385.     DO_PrintColor = Color.Extended
  1386.     DO_MoonDay = PrintDay
  1387.     DO_MoonMonth = NextMonth
  1388.     DO_MoonYear = NextYear
  1389.   end
  1390.   else do
  1391.     DO_PrintColor = Color.Moon
  1392.     DO_MoonDay = Day
  1393.     DO_MoonMonth = Month
  1394.     DO_MoonYear = EnteredYear
  1395.   end
  1396.   if (DoPhases ~= 0) & (MoonPhase.DO_MoonYear.DO_MoonMonth.DO_MoonDay ~= '') then do
  1397.     select
  1398.       when right(DoPhases, 1) == 'L' then DO_MoonLeft = BoxLeft + (MoonRadius * 1.2)
  1399.       when right(DoPhases, 1) == 'C' then DO_MoonLeft = BoxLeft + BoxWidth / 2
  1400.       when right(DoPhases, 1) == 'R' then DO_MoonLeft = BoxLeft + BoxWidth - (MoonRadius * 1.2)
  1401.     end
  1402.     if left(DoPhases, 1) == 'T' then DO_DX = MoonRadius * 1.2
  1403.     else if left(DoPhases, 1) == 'B' then DO_DX = BHeight - (MoonRadius * 1.2)
  1404.     MoonID.Day = DrawMoon(MoonPhase.DO_MoonYear.DO_MoonMonth.DO_MoonDay, DO_MoonLeft, BoxTop + DO_DX, DO_PrintColor)
  1405.     if left(DoPhases, 1) == 'T' then MoonID.Day = 0
  1406.     call UpdateBusy(Req, 1)
  1407.   end
  1408.   if (i = 5) & (MoonPhase.EnteredYear.Month.DO_PrevDay ~= '') then call Move(MoonID.DO_PrevDay, 0, -BoxHeight / 2)
  1409.   /**/
  1410.  
  1411.   return
  1412. /**/
  1413.  
  1414. /***//*******  DoSetupReq () Subroutine  ***********/
  1415. DoSetupReq:
  1416.   ActiveJulian   = 0
  1417.   ActiveJulian.  = 0
  1418.   ActiveSunCalc  = 0
  1419.   ActiveSunCalc. = 0
  1420.   Option.        = 0
  1421.  
  1422.   do opt = 1 + (PhaseLib ~= 1) to 5 + 3 * exists(Storage'suncalc')
  1423.     interpret 'DoValue = Do'Do.opt
  1424.     if (DoValue ~= 0) & (length(DoValue) == 1) then DoValue = 'B'DoValue
  1425.     interpret 'posn = Option.'opt
  1426.     if ((DoValue == 0) | (symbol(DoValue) == 'LIT')) & (posn == 0) then interpret 'Option.'DoValue' = MXPos.'Do.opt
  1427.   end
  1428.  
  1429.   do i = 0 to 4
  1430.     grp = pos.i
  1431.     option = Option.grp
  1432.     if (Do.option == 'Sunset') & (DoSunrise == DoSunset) then interpret 'Option.'pos.i' = 'MXPos.BothS
  1433.     else if (Do.option == 'JulianLeft') & (DoJulian == DoJulianLeft) then interpret 'Option.'pos.i' = 'MXPos.BothJ
  1434.   end
  1435.  
  1436.   call bguilist('monthlist_',January$,February$,March$,April$,May$,June$,July$,August$,September$,October$,November$,December$)
  1437.   call bguilist('mxopts_',None$,Phases$,Weeknumber$,Julian$,JulLeft$,JulJulLeft$,Sunrise$,Sunset$,RiseSet$)
  1438.  
  1439.   call UpdateBusy(Req, 1)
  1440.   g=bguivgroup(,
  1441.     bguiinfo('dummy_',,esc||'c'PrefsName)bguilayout(LGO_FixMinHeight, 1)||,
  1442.     bguimx('mainswitcher_',,bguilist('mainpnames_',OptLayout$,Variables$,Top$,Bottom$),'T')bguilayout(LGO_FixMinHeight,1)||,
  1443.     bguipages('mainpages_',,
  1444.       bguivgroup(,
  1445.         bguihgroup(,
  1446.           bguivgroup(,
  1447.             bguicheckbox('minicals_',MiniCals$, DoMiniCals)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1448.             bguicheckbox('highlights_',Highlights$, DoHighlights)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1449.             bguicheckbox('extended_',Extended$, DoExtended)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1450.           )||,
  1451.           bguivarspace(10)||,
  1452.           bguivgroup(,
  1453.             bguicheckbox('dateboxes_',BoxDates$, DoDateBox)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1454.             bguicheckbox('backgrounds_',Backgrounds$, DoBackgrounds)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1455.             bguicheckbox('images_',Images$, DoImages)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1456.           ),
  1457.         ,-2,'F',Options$)||,
  1458.         bguivgroup(,
  1459.           bguihgroup(,
  1460.             bguivarspace(40)||,
  1461.             bguistring('topmargin_',,Margin.Top,8)bguilayout(LGO_FixMinHeight, 1)bguilayout(LGO_Weight,20)||,
  1462.             bguivarspace(40),
  1463.           )||,
  1464.           bguihgroup(,
  1465.             bguivarspace(20)||,
  1466.             bguistring('leftmargin_',,Margin.Left,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
  1467.             bguicycle('orientation_',,bguilist('orientlist_',Wide$,Tall$))bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
  1468.             bguistring('rightmargin_',,Margin.Right,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
  1469.             bguivarspace(20),
  1470.           )||,
  1471.           bguihgroup(,
  1472.             bguivarspace(40)||,
  1473.             bguistring('bottommargin_',,Margin.Bottom,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
  1474.             bguivarspace(40),
  1475.           ),
  1476.         ,-2,'F',OrientMarg$),
  1477.       )||,
  1478.       bguivgroup(,
  1479.         bguihgroup(,
  1480.           bguicycle('fontvar_',,'FontName')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  1481.           bguistring('fontvalue_',,value(FontName),256)bguilayout(LGO_FixMinHeight,1)||,
  1482.           bguiibutton('addfont_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1),
  1483.         ,-2,'F',Fonts$)||,
  1484.         bguivgroup(,
  1485.           bguihgroup(,
  1486.             bguicycle('colorvar_',,'ColorName')bguilayout(LGO_FixMinHeight, 1)||,
  1487.             bguicycle('colorlist_',,'ColorList')bguilayout(LGO_FixMinHeight, 1),
  1488.           )||,
  1489.           bguihgroup(,
  1490.             bguivarspace(1)||,
  1491.             bguicheckbox('matchcolors_',MatchColors$, DoMatchColors)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1492.           )||,
  1493.           bguihgroup(,
  1494.             bguivarspace(1)||,
  1495.             bguicheckbox('dailycolors_',DailyColors$, DoDailyColors)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1496.           ),
  1497.         ,-2,'F',Colors$)||,
  1498.         bguihgroup(,
  1499.           bguicycle('currentvar_',,'VarName')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  1500.           bguistring('currentvalue_',,VarVal,256)bguilayout(LGO_FixMinHeight,1),
  1501.         ,-2,'F',MiscVar$),
  1502.       ,-2)||,
  1503.       bguihgroup(,
  1504.         bguivarspace(40)||,
  1505.         bguivgroup(,
  1506.           bguimx('topcenter_',Top$||'0a'x||Center$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1507.         ,-3,'F')||,
  1508.         bguivgroup(,
  1509.           bguimx('topright_',Top$||'0a'x||Right$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1510.         ,-3,'F'),
  1511.       )||,
  1512.       bguihgroup(,
  1513.         bguivgroup(,
  1514.           bguimx('bottomleft_',Bottom$||'0a'x||Left$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1515.         ,-3,'F')||,
  1516.         bguivgroup(,
  1517.           bguimx('bottomcenter_',Bottom$||'0a'x||Center$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1518.         ,-3,'F')||,
  1519.         bguivgroup(,
  1520.           bguimx('bottomright_',Bottom$||'0a'x||Right$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1521.         ,-3,'F'),
  1522.       ),
  1523.     )||,
  1524.     bguihgroup(,
  1525.       bguicycle('monthchoice_',,'monthlist_')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1526.       bguistring('yearchoice_',,Year,5)bguilayout(LGO_FixMinHeight, 1),
  1527.     )||,
  1528.     bguihgroup(,
  1529.       bguibutton('monthly_',Monthly$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1530.       bguibutton('yearly_',WholeYear$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1531.       bguivarspace(2)||,
  1532.       bguibutton('reset_',Reset$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1533.       bguibutton('load_',Load$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1534.       bguibutton('export_',Export$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1535.       bguivarspace(2)||,
  1536.       bguibutton('cancel_',Cancel$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1537.     ),
  1538.   ,'-3','-3')
  1539.  
  1540.   call UpdateBusy(Req, 1)
  1541.   winID=bguiwindow(VarGUITitle$,g,0,0,,PubScreen)
  1542.  
  1543.   if App == 'PGS' then do
  1544.     FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
  1545.     call UpdateBusy(Req, 1)
  1546.     FontwinID=bguiwindow(SelectFont$,FontGroup,20,50,,PubScreen)
  1547.   end
  1548.  
  1549.   ExportwinID = bguiwindow('',bguivgroup(bguiinfo('dummy_',,esc''Exporting$'...')),0,0,,PubScreen)
  1550.  
  1551.   do i = 0 to GroupCount
  1552.     interpret 'call bguiset('grp.i',winID,MX_Active,Option.'pos.i')'
  1553.     call ControlMX(i)
  1554.     if PhaseLib ~= 1 then interpret 'call bguiset('grp.i',winID,MX_DisableButton,1)'
  1555.     if ~exists(Storage'suncalc') then interpret 'call bguiset('grp.i',winID,MX_DisableButton,6,MX_DisableButton,7,MX_DisableButton,8)'
  1556.   end
  1557.   call bguiset(obj.orientation_,winID,CYC_Active,OrientChoice)
  1558.   call bguiset(obj.monthchoice_,winID,CYC_Active,CalMonth-1)
  1559.   call bguiset(obj.colorlist_,winID,CYC_Active,max(0, MemberID(Value(ColorName),'ColorList')))
  1560.   CurrentColor = bguiget(obj.colorlist_, CYC_Active)
  1561.   call bguiset(obj.currentvar_,,BT_Key,'09'x)
  1562.   call bguiset(obj.currentvalue_,,BT_Key,'0d'x)
  1563.   call bguiset(obj.images_,winID,GA_Disabled,~exists(Storage''GfxApp))
  1564.   call bguiaddmap(obj.mainswitcher_,obj.mainpages_,MX_Active,PAGE_Active)
  1565.   call bguiwintabcycleorder(winID,obj.topmargin_||obj.leftmargin_||obj.rightmargin_||obj.bottommargin_)
  1566.  
  1567.   if bguiwinopen(winID)=0 then bguierror(12)
  1568.  
  1569.   if Req ~= 0 then call bguiwinclose(Req)
  1570.  
  1571.   CalType = 0
  1572.   Reset   = 0
  1573.   do while 1
  1574.     call bguiwinwaitevent(winID,'ID')
  1575.     select
  1576.       when (id == id.cancel_) | (id == id.winclose) then do
  1577.         call bguiwinclose(winID)
  1578.         call Cleanup
  1579.       end
  1580.       when id == id.reset_ then do
  1581.         Reset = 1
  1582.         address command 'delete >NIL: 'ScriptDir''ChangesFile' quiet'
  1583.         PrefsFile = 'Default'
  1584.         leave
  1585.       end
  1586.       when id == id.load_ then do
  1587.         CurrentPrefs = PrefsFile
  1588.         PrefsFile = bguifilereq(ScriptDir''"FWCalendar.prefs", SelectFile$, winID,DOPATTERNS,PatVar)
  1589.         if PrefsFile ~= '' then do
  1590.           if ~exists(PrefsFile) then do
  1591.             call bguireq(PrefsFile' 'CantFind$'...','*'OK$,'FWCalendar 'Notice$,winID)
  1592.             PrefsFile = CurrentPrefs
  1593.           end
  1594.           else do
  1595.             address command 'delete >NIL: 'ScriptDir''ChangesFile' quiet'
  1596.             Reset = 1
  1597.             leave
  1598.           end
  1599.         end
  1600.       end
  1601.       when id == id.export_ then do
  1602.         ExportFile = ''
  1603.         ExportFile = bguifilereq(ScriptDir, ExportFile$, winID)
  1604.         if ExportFile ~= '' then do
  1605.           if upper(NameOnly(ExportFile)) == upper(NameOnly(PrefsFile)) then call bguireq(esc'c'CantMatch$'...','*'OK$,'FWCalendar 'Notice$,winID)
  1606.           else if open('ExportFile', ExportFile, 'W') then do
  1607.             call bguiwinbusy(winID)
  1608.             call bguiwinopen(ExportwinID)
  1609.             call ExportVariables('ExportFile')
  1610.             call bguiwinclose(ExportwinID)
  1611.             call bguiwinready(winID)
  1612.             call close('ExportFile')
  1613.           end
  1614.           else call bguireq(ExportFile' 'CantOpen$'...','*'OK$,'FWCalendar 'Notice$,winID)
  1615.         end
  1616.       end
  1617.       when id == id.minicals_ then     DoMiniCals = sign(bguiget(obj.minicals_, GA_Selected))
  1618.       when id == id.highlights_ then   DoHighlights = sign(bguiget(obj.highlights_, GA_Selected))
  1619.       when id == id.extended_ then     DoExtended = sign(bguiget(obj.extended_, GA_Selected))
  1620.       when id == id.dateboxes_ then    DoDateBox = sign(bguiget(obj.dateboxes_, GA_Selected))
  1621.       when id == id.backgrounds_ then  DoBackgrounds = sign(bguiget(obj.backgrounds_, GA_Selected))
  1622.       when id == id.images_ then       DoImages = sign(bguiget(obj.images_, GA_Selected))
  1623.       when id == id.matchcolors_ then  DoMatchColors = sign(bguiget(obj.matchcolors_, GA_Selected))
  1624.       when id == id.dailycolors_ then  DoDailyColors = sign(bguiget(obj.dailycolors_, GA_Selected))
  1625.       when id == id.topmargin_ then    Margin.Top = bguiget(obj.topmargin_, STRINGA_TextVal)
  1626.       when id == id.leftmargin_ then   Margin.Left = bguiget(obj.leftmargin_, STRINGA_TextVal)
  1627.       when id == id.rightmargin_ then  Margin.Right = bguiget(obj.rightmargin_, STRINGA_TextVal)
  1628.       when id == id.bottommargin_ then Margin.Bottom = bguiget(obj.bottommargin_, STRINGA_TextVal)
  1629.       when id == id.orientation_ then do
  1630.         if bguiget(obj.orientation_,CYC_Active) == 0 then Orientation = 'Wide'
  1631.         else Orientation = 'Tall'
  1632.       end
  1633.       when id == id.fontvalue_ then do
  1634.         call bguireq('1b'x||"c"MustUse$,"*"OK$,'',winID)
  1635.         call bguiset(obj.fontvalue_, winID,STRINGA_TextVal, value(FontName))
  1636.       end
  1637.       when id == id.addfont_ then do
  1638.         if App == 'FW' then do
  1639.           FontFile = bguifilereq(CurrentDir'FWFonts/SWOLFonts/', SelectFont$, winID,,'#?')
  1640.           if FontFile ~= '' then call bguiset(obj.fontvalue_, winID, STRINGA_TextVal,FontFile)
  1641.         end
  1642.         else if App == 'PGS' then do
  1643.           call bguiwinbusy(winID)
  1644.           call bguiwinopen(FontwinID)
  1645.           do while 1
  1646.             call bguiwinwaitevent(FontwinID,'ID')
  1647.             if id = id.winclose then leave
  1648.             if id = id.fontlistview_ then do
  1649.               call bguiset(obj.fontvalue_, winID, STRINGA_TextVal,bguiget(obj.fontlistview_, LISTV_LastClicked))
  1650.               leave
  1651.             end
  1652.           end
  1653.           call bguiwinclose(FontwinID)
  1654.           call bguiwinready(winID)
  1655.         end
  1656.       end
  1657.       when id == id.fontvar_ then do
  1658.         interpret FontName" = '"strip(bguiget(obj.fontvalue_, STRINGA_TextVal),'B', "'"||'"')"'"
  1659.         FontName = value('FontName.'bguiget(obj.fontvar_, CYC_Active))
  1660.         call bguiset(obj.fontvalue_,winID,STRINGA_TextVal,Value(FontName))
  1661.       end
  1662.       when id == id.colorvar_ then do
  1663.         interpret ColorName' = "'value('ColorList.'bguiget(obj.colorlist_, CYC_Active))'"'
  1664.         ColorName = value('ColorName.'bguiget(obj.colorvar_, CYC_Active))
  1665.         call bguiset(obj.colorlist_,winID,CYC_Active,max(0, MemberID(Value(ColorName),'ColorList')))
  1666.         CurrentColor = bguiget(obj.colorlist_, CYC_Active)
  1667.       end
  1668.       when id == id.colorlist_ then do
  1669.         if (pos('BACKGROUND.', upper(ColorName)) == 0) & (bguiget(obj.colorlist_, CYC_Active) == ColorList.Count - 1) then do
  1670.           call bguireq('1b'x||"c"NotClear$,"*"OK$,'',winID)
  1671.           call bguiset(obj.colorlist_, winID, CYC_Active, CurrentColor)
  1672.         end
  1673.       end
  1674.       when id == id.currentvar_ then do
  1675.         Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
  1676.         if datatype(Value) == 'CHAR' then Value = "'"strip(Value,'B', "'"||'"')"'"
  1677.         if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
  1678.           IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
  1679.           interpret 'ImageFile.'IC' = 'Value
  1680.         end
  1681.         else interpret Varname' = 'Value
  1682.         VarName = value('VarName.'bguiget(obj.currentvar_, CYC_Active))
  1683.         if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
  1684.           IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
  1685.           call bguiset(obj.currentvalue_,winID,STRINGA_TextVal,value('ImageFile.IC'))
  1686.         end
  1687.         else call bguiset(obj.currentvalue_,winID,STRINGA_TextVal,Value(VarName))
  1688.       end
  1689.       when id == id.monthly_ then do
  1690.         CalType = 1
  1691.         EnteredYear = bguiget(obj.yearchoice_, STRINGA_TextVal)
  1692.         Month = bguiget(obj.monthchoice_, CYC_Active) + 1
  1693.       end
  1694.       when id == id.yearly_ then do
  1695.         CalType = 2
  1696.         EnteredYear = bguiget(obj.yearchoice_, STRINGA_TextVal)
  1697.         leave
  1698.       end
  1699.       when id == id.bottomleft_ then call ControlMX(0)
  1700.       when id == id.bottomcenter_ then call ControlMX(1)
  1701.       when id == id.bottomright_ then call ControlMX(2)
  1702.       when id == id.topcenter_ then call ControlMX(3)
  1703.       when id == id.topright_ then call ControlMX(4)
  1704.       otherwise nop
  1705.     end
  1706.     if CalType ~= 0 then leave
  1707.   end
  1708.   interpret FontName" = '"strip(bguiget(obj.fontvalue_, STRINGA_TextVal),'B', "'"||'"')"'"
  1709.  
  1710.   interpret ColorName' = "'value('ColorList.'bguiget(obj.colorlist_, CYC_Active))'"'
  1711.  
  1712.   Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
  1713.   if datatype(Value) == 'CHAR' then do
  1714.     Value = strip(Value,'B', "'"||'"')
  1715.     if pos("'", Value) ~= 0 then Value = '"'Value'"'
  1716.     else Value = "'"Value"'"
  1717.   end
  1718.   if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
  1719.     IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
  1720.     interpret 'ImageFile.'IC' = 'Value
  1721.   end
  1722.   else interpret Varname' = 'Value
  1723.   return
  1724. /**/
  1725.  
  1726. /***//*******  DrawBox (DB) Subroutine  ***********/
  1727. DrawBox:
  1728.   parse arg DB_x1, DB_y1, DB_width, DB_height, DB_Weight, DB_LineColor, DB_FillBool, DB_FillColor, DB_SendToBack
  1729.  
  1730.   if DB_FillColor == '<'Clear$'>' then DB_FillBool = 0
  1731.  
  1732.   if App == 'FW' then do
  1733.     if DB_Weight == 'HL' then DB_Weight = 'Hairline'
  1734.     else if DB_Weight == 0 then do
  1735.       DB_Weight = 'None'
  1736.       if DB_FillColor ~= '<'Clear$'>' then DB_LineColor = DB_FillColor
  1737.     end
  1738.  
  1739.     if DB_FillBool == 1 then DB_FillBool = 'Solid'
  1740.     else do
  1741.       DB_FillBool = 'Transparent'
  1742.       DB_FillColor = DB_LineColor
  1743.     end
  1744.  
  1745.     BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_LineColor'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
  1746.     DRAWBOX 1 DB_x1 DB_y1 DB_width DB_height; DB_id = result
  1747.     if DB_SendToBack == 1 then OBJECTTOBACK
  1748.   end
  1749.   else if App == 'PGS' then do
  1750.     if DB_Weight == 'HL' then DB_Weight = 0.3pt
  1751.     else DB_Weight = DB_Weight'pt'
  1752.  
  1753.     if DB_FillBool == 1 then DB_FillBool = 'ON'
  1754.     else DB_FillBool = 'OFF'
  1755.  
  1756.     If DB_Weight == 0 then DB_LineBool = 'OFF'
  1757.     else DB_LineBool = 'ON'
  1758.  
  1759.     DRAWBOX DB_x1 DB_y1 DB_x1+DB_width DB_y1+DB_height WINDOW winName; DB_id = result
  1760.     STROKED DB_LineBool OBJECT WINDOW winName
  1761.     SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECT WINDOW winName
  1762.     SETCOLORSTYLE '"'DB_LineColor'"' COLORNUMBER 0 STROKENUMBER 0 OBJECT WINDOW winName
  1763.     FILLED DB_FillBool OBJECT WINDOW winName
  1764.     SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECT WINDOW winName
  1765.     if DB_SendToBack == 1 then SENDTOBACK OBJECTID DB_id WINDOW winName
  1766.   end
  1767.   return DB_id
  1768. /**/
  1769.  
  1770. /***//*******  DrawHalf (DH) Subroutine  ***********/
  1771. DrawHalf:
  1772.   parse arg DH_Side
  1773.  
  1774.   if App == 'FW' then do
  1775.     if DH_Side == 'L' then DH_sign = -1
  1776.     else DH_sign = 1
  1777.  
  1778.     STARTPATH 1 DM_CtrX (DM_CtrY + MoonRadius)
  1779.     CURVETO 1 (DM_CtrX + (DH_sign * MoonRadius * BelzierFactor)) (DM_CtrY + MoonRadius) (DM_CtrX + (DH_sign * MoonRadius)) (DM_CtrY + MoonRadius * BelzierFactor) (DM_CtrX + (DH_sign * MoonRadius)) DM_CtrY
  1780.     CURVETO 1 (DM_CtrX + (DH_sign * MoonRadius)) (DM_CtrY - MoonRadius * BelzierFactor) (DM_CtrX + (DH_sign * MoonRadius * BelzierFactor)) (DM_CtrY - MoonRadius) DM_CtrX (DM_CtrY - MoonRadius)
  1781.     ENDPATH Close
  1782.   end
  1783.   else if App == 'PGS' then do
  1784.     if DH_Side == 'L' then DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 90 270 WINDOW winName
  1785.     else DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 270 90 WINDOW winName
  1786.   end
  1787.   return result
  1788. /**/
  1789.  
  1790. /***//*******  DrawLine (DL) Subroutine  ***********/
  1791. DrawLine:
  1792.   parse arg DL_x1, DL_y1, DL_x2, DL_y2, DL_Weight, DL_Color
  1793.  
  1794.   if App == 'FW' then do
  1795.     if DL_Weight == 'HL' then DL_Weight = 'Hairline'
  1796.     else if DL_Weight == 0 then DL_Weight = 'None'
  1797.  
  1798.     LINEPREFS LINEWT DL_Weight LINECOLOR '"'DL_Color'"'
  1799.     DRAWLINE 1 DL_x1 DL_y1 DL_x2 DL_y2
  1800.   end
  1801.   else if App == 'PGS' then do
  1802.     if DL_Weight == 'HL' then DL_Weight = '0.3pt'
  1803.     else DL_Weight = DL_Weight'pt'
  1804.  
  1805.     DRAWLINE DL_x1 DL_y1 DL_x2 DL_y2 WINDOW winName
  1806.     STROKED ON OBJECT WINDOW winName
  1807.     SETSTROKEWEIGHT DL_Weight STROKENUMBER 0 OBJECT
  1808.     SETCOLORSTYLE '"'DL_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECT WINDOW winName
  1809.   end
  1810.   return
  1811. /**/
  1812.  
  1813. /***//*******  DrawMiniCal (DMC) Subroutine  ***********/
  1814. DrawMiniCal:
  1815.   parse arg DMC_MiniDirection, DMC_CalWidth, DMC_FontType
  1816.  
  1817.   DMC_ColumnWidth = DMC_CalWidth/8
  1818.   DMC_BoxCount = 0
  1819.  
  1820.   DMC_MiniMonth = Month + DMC_MiniDirection
  1821.   if DMC_MiniMonth == 0 | DMC_MiniMonth == 13 then do
  1822.     DMC_MiniMonth = abs(DMC_MiniMonth - 12)
  1823.     Year = EnteredYear + DMC_MiniDirection
  1824.   end
  1825.   else Year = EnteredYear
  1826.   Mn = right(DMC_MiniMonth, 2, '0')
  1827.   if DoHighlights == 1 then call SetHighlights
  1828.  
  1829.   if DMC_MiniDirection < 0 then do
  1830.     DMC_StartColumn = StartDate - MonthLength.DMC_MiniMonth//7
  1831.     If DMC_StartColumn < 0 then DMC_StartColumn = DMC_StartColumn + 7
  1832.     DMC_MiniCalLeft = Margin.Left + ShiftLMini
  1833.   end
  1834.   else if DMC_MiniDirection > 0 then do
  1835.     DMC_StartColumn = StartDate + MonthLength.Month//7
  1836.     If DMC_StartColumn > 6 then DMC_StartColumn = DMC_StartColumn - 7
  1837.     DMC_MiniCalLeft = FullWidth - Margin.Right - DMC_CalWidth + ShiftRMini
  1838.   end
  1839.   else do
  1840.     DMC_StartColumn = StartDate
  1841.     DMC_MiniCalLeft = Margin.Left + c * (DMC_CalWidth + MiniCalSpacing)
  1842.   end
  1843.  
  1844.   /* Print Month & Year */
  1845.   DMC_ID.0 = PrintText(1, Margin.Top, DMC_FontType, 'N', Color.MiniCal, Width.DMC_FontType, Month.DMC_MiniMonth' 'Year)
  1846.   call UpdateBusy(Req, 1)
  1847.   if App == 'FW' then do
  1848.     Redraw
  1849.     GetObjectCoords DMC_ID.0; Parse var RESULT . . DMC_Text.Top DMC_Text.Width .
  1850.     DMC_Text.Left = DMC_MiniCalLeft + (DMC_CalWidth - DMC_Text.Width)/2
  1851.     SetObjectCoords DMC_ID.0 1 DMC_Text.Left DMC_Text.Top DMC_Text.Width Height.DMC_FontType
  1852.   end
  1853.   else if App == 'PGS' then do
  1854.     GETTEXTOBJ POSITION DMC_Text OBJECTID DMC_ID.0 WINDOW winName
  1855.     DMC_Text.Width = DMC_Text.Right - DMC_Text.Left
  1856.     DMC_Text.Left = DMC_MiniCalLeft + (DMC_CalWidth - DMC_Text.Width)/2
  1857.     EDITTEXTOBJ POSITION DMC_Text.Left DMC_Text.Top (DMC_Text.Left + DMC_Text.Width) DMC_Text.Bottom OBJECTID DMC_ID.0 WINDOW winName
  1858.   end
  1859.  
  1860.   /* Print Days */
  1861.   DMC_Column = DMC_StartColumn
  1862.   DMC_Day = 0
  1863.   DMC_Row = 1
  1864.   Do Until DMC_Day = MonthLength.DMC_MiniMonth
  1865.     DMC_Day = DMC_Day + 1
  1866.     DMC_Char1 = left(right(DMC_Day, 2, ' '), 1)
  1867.     DMC_Char2 = right(DMC_Day, 1)
  1868.     if (Highlight.DMC_MiniMonth.DMC_Day == '') | (symbol('Highlight.DMC_MiniMonth.DMC_Day') == 'LIT') then do
  1869.       DMC_Style = 'N'
  1870.       if CenterMiniDates == 1 then DMC_CenterAdj = (DMC_ColumnWidth - 2*NormalWidth.Widest)/2 + (NormalWidth.Widest * 2 - NormalWidth.DMC_Char1 - NormalWidth.DMC_Char2) / 2 + NormalWidth.DMC_Char1 + NormalWidth.DMC_Char2
  1871.       else DMC_CenterAdj = (DMC_ColumnWidth - 2*NormalWidth.Widest)/2 + (NormalWidth.Widest - NormalWidth.DMC_Char2) / 2 + NormalWidth.DMC_Char1 + NormalWidth.DMC_Char2
  1872.     end
  1873.     else do
  1874.       DMC_Style = 'B'
  1875.       if CenterMiniDates == 1 then DMC_CenterAdj = (DMC_ColumnWidth - 2*BoldWidth.Widest)/2 + (BoldWidth.Widest * 2 - BoldWidth.DMC_Char1 - BoldWidth.DMC_Char2) / 2 + BoldWidth.DMC_Char1 + BoldWidth.DMC_Char2
  1876.       else DMC_CenterAdj = (DMC_ColumnWidth - 2*BoldWidth.Widest)/2 + (BoldWidth.Widest - BoldWidth.DMC_Char2) / 2 + BoldWidth.DMC_Char1 + BoldWidth.DMC_Char2
  1877.     end
  1878.  
  1879.     DMC_Text.Right = (DMC_Column + 1.5) * DMC_ColumnWidth
  1880.     DMC_Text.Top   = Margin.Top + DMC_Row*Height.DMC_FontType
  1881.  
  1882.     DMC_Text.Left = DMC_MiniCalLeft + DMC_Text.Right - DMC_CenterAdj
  1883.     DMC_ID.DMC_Day = PrintText(DMC_Text.Left, DMC_Text.Top, DMC_FontType, DMC_Style, Color.MiniCal, Width.DMC_FontType, DMC_Day)
  1884.     call UpdateBusy(Req, 1)
  1885.  
  1886.     if pos('#', Highlight.DMC_MiniMonth.DMC_Day) > 0 then do
  1887.       DMC_BoxCount = DMC_BoxCount + 1
  1888.       DMC_Box.Left = DMC_MiniCalLeft + (DMC_Column + .5) * DMC_ColumnWidth
  1889.       DMC_BoxID.DMC_BoxCount = DrawBox(DMC_Box.Left, DMC_Text.Top - (Height.DMC_FontType * ((1 - TextAdj) / 3) * (App == 'FW')), DMC_ColumnWidth, Height.DMC_FontType, 'HL', Line.MiniCal, 0, Black$, 1)
  1890.       if App == 'FW' then OBJECTTOBACK
  1891.       else if App == 'PGS' then SENDTOBACK OBJECTID DMC_BoxID.DMC_BoxCount WINDOW winName
  1892.     end
  1893.  
  1894.     DMC_Column = DMC_Column + 1
  1895.     if DMC_Column == 7 then do
  1896.       DMC_Column = 0
  1897.       DMC_Row = DMC_Row + 1
  1898.     end
  1899.   end
  1900.  
  1901.   call DrawBox(DMC_MiniCalLeft, Margin.Top, DMC_CalWidth, 7*Height.DMC_FontType, 'HL', Line.MiniCal, 1, Background.MiniCal, 1)
  1902.   call UpdateBusy(Req, 1)
  1903.  
  1904.   if App == 'FW' then do
  1905.     REDRAW
  1906.     do DMC_i = 0 to MonthLength.DMC_MiniMonth; SELECTOBJECT DMC_ID.DMC_i MULTIPLE; End
  1907.     do DMC_i = 1 to DMC_BoxCount; SELECTOBJECT DMC_BoxID.DMC_i MULTIPLE; End
  1908.     GROUP
  1909.   end
  1910.   if App == 'PGS' then do
  1911.     do DMC_i = 0 to MonthLength.DMC_MiniMonth; SELECTOBJECT ObjectID DMC_ID.DMC_i Add WINDOW winName; End
  1912.     do DMC_i = 1 to DMC_BoxCount; SELECTOBJECT ObjectID DMC_BoxID.DMC_i Add WINDOW winName; End
  1913.     GROUP WINDOW winName
  1914.   end
  1915. return
  1916. /**/
  1917.  
  1918. /***//*******  DrawMoon (DM) Subroutine  ***********/
  1919. DrawMoon:
  1920.   parse arg DM_Phase, DM_CtrX, DM_CtrY, DM_Color
  1921.  
  1922.   if App == 'FW' then do
  1923.     if (DM_Phase == 'N') | (DM_Phase == 'F') then do
  1924.       if DM_Phase == 'N' then DM_FillColor = DM_Color
  1925.       else DM_FillColor = White$
  1926.       OVALPREFS LINEWT 'Hairline' LINECOLOR '"'DM_Color'"' FILL 'Solid' FILLCOLOR '"'DM_FillColor'"'
  1927.       DRAWOVAL 1 (DM_CtrX - MoonRadius) (DM_CtrY - MoonRadius) (2 * MoonRadius) (2 * MoonRadius)
  1928.       DM_id = result
  1929.     end
  1930.     else do
  1931.       SHAPEPREFS LINEWT 'Hairline' LINECOLOR '"'DM_Color'"' FILL 'Solid' FILLCOLOR '"'DM_Color'"'
  1932.       if DM_Phase == 1 then DM_HalfID = DrawHalf('R')
  1933.       else DM_HalfID = DrawHalf('L')
  1934.       SHAPEPREFS FILLCOLOR '"'White$'"'
  1935.       if DM_Phase == 1 then DM_Half2ID = DrawHalf('L')
  1936.       else DM_Half2ID = DrawHalf('R')
  1937.       SELECTOBJECT DM_HalfID
  1938.       SELECTOBJECT DM_Half2ID Multiple
  1939.       GROUP
  1940.       CURRENTOBJECT; DM_id = result
  1941.     end
  1942.   end
  1943.   else if App == 'PGS' then do
  1944.     if (DM_Phase == 'N') | (DM_Phase == 'F') then do
  1945.       DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius WINDOW winName
  1946.       DM_id = result
  1947.       if DM_Phase == 'N' then call SetFill(DM_id, DM_Color, DM_Color)
  1948.       else call SetFill(DM_id, DM_Color, White$)
  1949.     end
  1950.     else do
  1951.       DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 90 270 WINDOW winName
  1952.       DM_LHalfID = result
  1953.       if DM_Phase == 1 then call SetFill(DM_LHalfID, DM_Color, White$)
  1954.       else call SetFill(DM_LHalfID, DM_Color, DM_Color)
  1955.       DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 270 90 WINDOW winName
  1956.       DM_RHalfID = result
  1957.       if DM_Phase == 1 then call SetFill(DM_RHalfID, DM_Color, DM_Color)
  1958.       else call SetFill(DM_RHalfID, DM_Color, White$)
  1959.       SELECTOBJECT OBJECTID DM_LHalfID Add WINDOW winName
  1960.       GROUP WINDOW winName; DM_id = result
  1961.     end
  1962.   end
  1963.  
  1964.   return DM_id
  1965. /**/
  1966.  
  1967. /***//*******  ExportVariables (EV) Subroutine  *********/
  1968. ExportVariables:
  1969.   parse arg EV_File
  1970.  
  1971.   call open('Temp', FullCallPath)
  1972.     EV_FileOffset = 120000
  1973.     call seek('Temp', EV_FileOffset, 'B')
  1974.     do until (EV_EndPos ~= 0) | (EV_PrevOffset = EV_FileOffset)
  1975.       EV_PrevOffset = EV_FileOffset
  1976.       EV_Chunk = readch('Temp', 65535)
  1977.       EV_EndPos = pos('VarList:'||'0a'x, EV_Chunk)
  1978.       if EV_EndPos == 0 then EV_FileOffset = seek('Temp', -10, 'C')
  1979.     end
  1980.     call seek('Temp', EV_FileOffset + EV_EndPos + 8, 'B')
  1981.     EV_DefaultVariables = readch('Temp', 65535)
  1982.   call close('Temp')
  1983.  
  1984.   call openv('EV_DefaultVariables')
  1985.     do forever
  1986.       EV_VarLine = strip(readvln('EV_DefaultVariables'))
  1987.       EV_VarName = strip(word(EV_VarLine, 1))
  1988.       EV_VarVal  = strip(substr(EV_VarLine, pos('=', EV_VarLine) + 1))
  1989.       if EV_VarLine == 'return' then leave
  1990.       EV_Existing = MemberID(EV_VarName, 'RD_Var')
  1991.       if EV_Existing == -1 then iterate
  1992.       interpret 'EV_DefaultValue = 'EV_VarVal
  1993.       EV_CurrentVal = value(value('RD_Var.'EV_Existing))
  1994.       if EV_CurrentVal ~= EV_DefaultValue then do
  1995.         if datatype(EV_CurrentVal) == 'CHAR' then EV_CurrentVal = '"'EV_CurrentVal'"'
  1996.         call writeln(EV_File, right(EV_VarName, VarNameMaxLn)' = 'EV_CurrentVal)
  1997.       end
  1998.     end
  1999.   call closev('EV_DefaultVariables')
  2000.   return
  2001. /**/
  2002.  
  2003. /***//*******  GetFontWidth (GFW) Subroutine  *********/
  2004. GetFontWidth:
  2005.   parse arg GFW_FontType, GFW_FontStyle, GFW_Char
  2006.  
  2007.   GFW_ID = PrintText(.5, .5, GFW_FontType, GFW_FontStyle, Black$, Width.GFW_FontType, GFW_Char)
  2008.   if App == 'FW' then do
  2009.     REDRAW
  2010.     GETOBJECTCOORDS GFW_ID; parse var RESULT . . . GFW_Width .
  2011.     DELETEOBJECT GFW_ID
  2012.   end
  2013.   else if App == 'PGS' then do
  2014.     GETTEXTOBJ POSITION GFW_Text OBJECTID GFW_ID WINDOW winName
  2015.     GFW_Width = GFW_Text.Right - GFW_Text.Left
  2016.     DELETEOBJECT OBJECTID GFW_ID WINDOW winName
  2017.   end
  2018. return GFW_Width
  2019. /**/
  2020.  
  2021. /***//*******  GetHeight (GH) Subroutine  ***********/
  2022. GetHeight:
  2023.   parse arg GH_FontType
  2024.  
  2025.   if App == 'FW' then do
  2026.     TEXTBLOCKTYPEPREFS SIZE FSize.GH_FontType FONT Font.GH_FontType
  2027.     DRAWTEXTBLOCK 1 1 1 'A'; GH_id = result
  2028.     GETOBJECTCOORDS GH_id; Parse Var result . . . . GH_Text.Height
  2029.   end
  2030.   else if App == 'PGS' then do
  2031.     DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
  2032.     SELECTTEXT AT 0 0 WINDOW winName
  2033.     BEGINCOMMANDCAPTURE
  2034.       SETLEADING RELATIVE 100
  2035.       SETTYPESIZE FSize.GH_FontType WINDOW winName
  2036.       SETFONT Font.GH_FontType WINDOW winName
  2037.     ENDCOMMANDCAPTURE
  2038.     INSERT 'A' WINDOW winName
  2039.     GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
  2040.     GH_Text.Height = GH_Text.Bottom - GH_Text.Top
  2041.     DELETEOBJECT OBJECTID GH_id WINDOW winName
  2042.   end
  2043.   return GH_Text.Height
  2044. /**/
  2045.  
  2046. /***//*******  GetLogInfo () Subroutine  ***********/
  2047. GetLogInfo:
  2048.   if ~exists(Storage'FWC'App'Temp.txt') then address command 'list >'Storage'FWC'App'Temp.txt 'AppName'#? lformat %N'
  2049.   if open('Temp', Storage'FWC'App'Temp.txt') ~= 0 then do
  2050.     do while ~eof('Temp')
  2051.       PgmName = readln('Temp')
  2052.       if pos('.', PgmName) == 0 then leave
  2053.     end
  2054.     call close('Temp')
  2055.   end
  2056.  
  2057.   if ~exists(Storage'FWC'App'VersionInfo.txt') then address command 'version >'Storage'FWC'App'VersionInfo.txt 'PgmName
  2058.  
  2059.   call open('Temp', Storage'FWC'App'VersionInfo.txt')
  2060.     address command 'copy 'Storage'FWC'App'VersionInfo.txt ram:versioninfo.txt'
  2061.     PgmVersion = readln('Temp')
  2062.   call close('Temp')
  2063.  
  2064.   if left(PgmVersion, 34) == 'Could not find version information' then do
  2065.     if App == 'FW' then do
  2066.       call open('Temp', CurrentDir''PgmName)
  2067.         /* Desired string at 325365 for v 5.06 */
  2068.         /* Desired string at 333771 for FW97   */
  2069.         FileOffset = 325300
  2070.         call seek('Temp', FileOffset, 'B')
  2071.         do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  2072.           PrevOffset = FileOffset
  2073.           Chunk = readch('Temp', 10000)
  2074.           EndPos = pos('Created', Chunk)
  2075.           if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
  2076.         end
  2077.         if EndPos == 0 then PgmVersion = 'Final Writer - version unknown'
  2078.         else do
  2079.           StartPos = lastpos('Final', Chunk, EndPos)
  2080.           EndPos = pos('00'x||'00'x, Chunk, StartPos)
  2081.           PgmVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
  2082.         end
  2083.       call close('Temp')
  2084.       call open('Temp', Storage'FWC'App'VersionInfo.txt', 'W')
  2085.         call writeln('Temp', PgmVersion)
  2086.       call close('Temp')
  2087.     end
  2088.     else PgmVersion = PgmName" - can't find version info"
  2089.   end
  2090.  
  2091.   return
  2092. /**/
  2093.  
  2094. /***//*******  GetMaxWidth (GMW) Subroutine  ***********/
  2095. GetMaxWidth:
  2096.   parse arg GMW_Stem, GMW_Count
  2097.  
  2098.   GMW_maxwidth = 0
  2099.   Do GMW_i = 0 to GMW_Count
  2100.     interpret 'GMW_ObjectID = 'GMW_Stem'.'GMW_i
  2101.     if App = 'FW' then do
  2102.       GETOBJECTCOORDS GMW_ObjectID
  2103.       Parse Var result . . . GMW_width .
  2104.     end
  2105.     else if App == 'PGS' then do
  2106.       SELECTOBJECT ObjectID GMW_ObjectID WINDOW winName
  2107.       GETTEXTOBJ POSITION GMW_Temp OBJECTID GMW_ObjectID WINDOW winName
  2108.       GMW_width = GMW_Temp.Right - GMW_Temp.Left
  2109.     end
  2110.     GMW_maxwidth = max(GMW_width, GMW_maxwidth)
  2111.   end
  2112.  
  2113.   return GMW_maxwidth
  2114. /**/
  2115.  
  2116. /***//*******  GetMiniMax (GMM) Subroutine  ***********/
  2117. GetMiniMax:
  2118.   parse arg GMM_FontType
  2119.  
  2120.   NormalWidth.Widest = 0
  2121.   BoldWidth.Widest = 0
  2122.   do GMM_i = 0 to 9
  2123.     NormalWidthID.GMM_i = PrintText(1, 1, GMM_FontType, 'N', Black$, Width.GMM_FontType, GMM_i)
  2124.     BoldWidthID.GMM_i = PrintText(1, 1, GMM_FontType, 'B', Black$, Width.GMM_FontType, GMM_i)
  2125.   end
  2126.   if App == 'FW' then REDRAW
  2127.   do GMM_i = 0 to 9
  2128.     NormalWidth.GMM_i = GetWidth(NormalWidthID.GMM_i)
  2129.     BoldWidth.GMM_i = GetWidth(BoldWidthID.GMM_i)
  2130.     NormalWidth.Widest = max(NormalWidth.Widest, NormalWidth.GMM_i)
  2131.     BoldWidth.Widest = max(BoldWidth.Widest, BoldWidth.GMM_i)
  2132.     if App == 'PGS' then do
  2133.       DELETEOBJECT OBJECTID NormalWidthID.GMM_i WINDOW winName
  2134.       DELETEOBJECT OBJECTID BoldWidthID.GMM_i WINDOW winName
  2135.     end
  2136.   end
  2137.  
  2138.   return
  2139. /**/
  2140.  
  2141. /***//*******  GetPhases (GP) Subroutine  ***********/
  2142. GetPhases:
  2143.   parse arg GP_Y, GP_Month
  2144.  
  2145.   if DateLib == 1 then do
  2146.     GP_Phase.0 = 'N'
  2147.     GP_Phase.1 = '1'
  2148.     GP_Phase.2 = 'F'
  2149.     GP_Phase.3 = '3'
  2150.  
  2151.     GP_JD = date_GregorianToJD(1, GP_Month, GP_Y)
  2152.     do GP_SeqDate = GP_JD - 22 to GP_JD + 39
  2153.       call date_JDToGregorian(GP_SeqDate, 'GP_DAY GP_MONTH GP_YEAR')
  2154.  
  2155.       do GP_Phase = 0 to 3
  2156.         GP_SeqDate = date_GregorianMoonPhase(GP_Day, GP_Month, GP_Year, GP_Phase)
  2157.         call date_JDToGregorian(GP_SeqDate, 'GP_DAY GP_MONTH GP_YEAR')
  2158.         MoonPhase.GP_Year.GP_Month.GP_Day = GP_Phase.GP_Phase
  2159.       end
  2160.     end
  2161.   end
  2162.   else do
  2163.     /* Routine to determine the dates of the new and full moons for a given year */
  2164.     /* obtained from the Sky & Telescope web site. The basic program from which  */
  2165.     /* the following was derived originally appeared in Astronomical Computing,  */
  2166.     /* Sky & Telescope, March, 1985                                              */
  2167.     GP_Progress = -2
  2168.     GP_R1 = PI(0) / 180
  2169.     GP_NextPhase = 29.530588853 / 4
  2170.     GP_U  = 0
  2171.  
  2172.     GP_K0 = trunc((GP_Y - 1900) * 12.3685)
  2173.     GP_T  = (GP_Y - 1899.5) / 100
  2174.     GP_T2 = GP_T*GP_T
  2175.     GP_T3 = GP_T*GP_T*GP_T
  2176.     GP_J0 = 2415020 + 29 * GP_K0
  2177.     GP_F0 = 0.0001178 * GP_T2 - 0.000000155 * GP_T3 + 0.75933 + 0.53058868 * GP_K0 - 0.000837 * GP_T - 0.000335 * GP_T2
  2178.  
  2179.     GP_J0  = GP_J0 + trunc(GP_F0)
  2180.     GP_F0  = GP_F0 - trunc(GP_F0)
  2181.  
  2182.     GP_M0 = GP_K0 * 0.08084821133
  2183.     GP_M0 = 360 * (GP_M0 - trunc(GP_M0)) + 359.2242 - 0.0000333 * GP_T2 - 0.00000347 * GP_T3
  2184.     GP_M1 = GP_K0 * 0.07171366128
  2185.     GP_M1 = 360 * (GP_M1 - trunc(GP_M1)) + 306.0253 + 0.0107306 * GP_T2 + 0.00001236 * GP_T3
  2186.     GP_B1 = GP_K0 * 0.08519585128
  2187.     GP_B1 = 360 * (GP_B1 - trunc(GP_B1)) + 21.2964 - 0.0016528 * GP_T2 - 0.00000239 * GP_T3
  2188.     do GP_K9 = 0 to 28
  2189.       if GP_K9//4 == 0 then do
  2190.         GP_Progress = -GP_Progress
  2191.         call UpdateBusy(Req, GP_Progress)
  2192.       end
  2193.       GP_J  = GP_J0 + 14 * GP_K9
  2194.       GP_F  = GP_F0 + 0.765294 * GP_K9
  2195.       GP_K  = GP_K9 / 2
  2196.       GP_M5 = (GP_M0 + GP_K * 29.10535608) * GP_R1
  2197.       GP_M6 = (GP_M1 + GP_K * 385.81691806) * GP_R1
  2198.       GP_B6 = (GP_B1 + GP_K * 390.67050646) * GP_R1
  2199.       GP_F  = GP_F - 0.4068 * SIN(GP_M6) + (0.1734 - 0.000393 * GP_T) * SIN(GP_M5) + 0.0161 * SIN(2 * GP_M6)
  2200.       GP_F  = GP_F + 0.0104 * SIN(2 * GP_B6) - 0.0074 * SIN(GP_M5 - GP_M6) - 0.0051 * SIN(GP_M5 + GP_M6)
  2201.       GP_F  = GP_F + 0.0021 * SIN(2 * GP_M5) + 0.0010 * SIN(2 * GP_B6 - GP_M6)
  2202.       GP_J  = GP_J + trunc(GP_F)
  2203.       GP_F  = GP_F - trunc(GP_F)
  2204.  
  2205.       GP_Converted  = ConvertJ(GP_F, GP_J)
  2206.       GP_Y          = word(GP_Converted, 1) - 0
  2207.       GP_M          = word(GP_Converted, 2) - 0
  2208.       GP_Day        = word(GP_Converted, 3) - 0
  2209.       GP_Hrs        = word(GP_Converted, 4)
  2210.       if GP_U = 0 then do
  2211.         MoonPhase.GP_Y.GP_M.GP_Day = 'N'
  2212.         GP_FQ = DateInfo('S', trunc(DateInfo('I', GP_Y''right(GP_M, 2, '0')''right(GP_Day, 2, '0'), 'S') + GP_Hrs + GP_NextPhase))
  2213.         GP_Y = left(GP_FQ, 4)
  2214.         GP_M = strip(substr(GP_FQ, 5, 2), 'L', '0')
  2215.         GP_Day = strip(right(GP_FQ, 2), 'L', '0')
  2216.         MoonPhase.GP_Y.GP_M.GP_Day = '1'
  2217.       end
  2218.       if GP_U = 1 then do
  2219.         MoonPhase.GP_Y.GP_M.GP_Day = 'F'
  2220.         GP_TQ = DateInfo('S', trunc(DateInfo('I', GP_Y''right(GP_M, 2, '0')''right(GP_Day, 2, '0'), 'S') + GP_Hrs + GP_NextPhase))
  2221.         GP_Y = left(GP_TQ, 4)
  2222.         GP_M = strip(substr(GP_TQ, 5, 2), 'L', '0')
  2223.         GP_Day = strip(right(GP_TQ, 2), 'L', '0')
  2224.         MoonPhase.GP_Y.GP_M.GP_Day = '3'
  2225.       end
  2226.       GP_U = GP_U + 1
  2227.       if GP_U = 2 then GP_U = 0
  2228.     end
  2229.     if sign(GP_Progress) == 1 then call UpdateBusy(Req, -GP_Progress)
  2230.   end
  2231. return 0
  2232. /**/
  2233.  
  2234. /***//*******  GetSetupInfo (GSI) Subroutine  ***********/
  2235. GetSetupInfo:
  2236.   Year = left(date('S'),4)
  2237.   ThisMonth = left(date('U'), 2) + 0
  2238.  
  2239.   if (owner == 'rgoertz') & (CallHost == 'REXX') then CalMonth = ThisMonth
  2240.   else do
  2241.     CalMonth = getclip('FWC_CalMonth')
  2242.     if datatype(CalMonth) == 'CHAR' then do
  2243.       CalMonth = ThisMonth
  2244.       AddYear = 0
  2245.     end
  2246.     else do
  2247.       CalMonth = CalMonth + 1
  2248.       if CalMonth = 13 then do
  2249.         CalMonth = 1
  2250.         AddYear = 1
  2251.       end
  2252.       else AddYear = 0
  2253.     end
  2254.     CalYear = getclip('FWC_CalYear')
  2255.     if (CalYear ~= '') & (DataType(CalYear) == 'NUM') then Year = CalYear + AddYear
  2256.   end
  2257.  
  2258.   call InitializeVariables
  2259.  
  2260.   PrefsFile = 'Default'
  2261.   if (exists(ScriptDir''ChangesFile)) & (word(statef(ScriptDir''ChangesFile), 2) > 2) then do
  2262.     if open('DataFile', ScriptDir''ChangesFile) then do
  2263.       GSI_Data = readch('DataFile', 65535)
  2264.       call close('DataFile')
  2265.       call OpenV('GSI_Data')
  2266.         GSI_StringVar = 0
  2267.         do until eofv('GSI_Data')
  2268.           GSI_Ln = readvln('GSI_Data')
  2269.           GSI_Var = upper(word(GSI_Ln, 1))
  2270.           if (right(GSI_Var, 1) == '$') |,
  2271.              (GSI_Var == 'DOSHANGHAI') |,
  2272.              (GSI_Var == 'STORAGE') |,
  2273.              (GSI_Var == 'PREFSFILE') then interpret GSI_Ln
  2274.         end
  2275.       call CloseV('GSI_Data')
  2276.     end
  2277.   end
  2278.  
  2279.   call makedir(left(Storage, length(Storage) - 1))
  2280.   call ReadTranslations
  2281.   call InitializeSettings
  2282.  
  2283.   do until Reset == 0
  2284.     call CheckShanghai
  2285.     call ReadTranslations
  2286.     Req = OpenBusy(PrepReq$'...', 6)
  2287.     call CreateDataFile
  2288.     call ReadData
  2289.     call CheckShanghai
  2290.     call DoSetupReq
  2291.     call CheckShanghai
  2292.     if Reset == 1 then call bguiwinclose(winID)
  2293.   end
  2294.  
  2295.   if ImageClass.0 ~= '' then
  2296.     do GSI_i = 0 to ImageClass.Count - 1
  2297.       parse var ImageFile.GSI_i ImageFile.GSI_i ',' GSI_DX ',' GSI_DY
  2298.       GSI_DX = strip(GSI_DX);if GSI_DX == '' then GSI_DX = 0
  2299.       GSI_DY = strip(GSI_DY);if GSI_DY == '' then GSI_DY = 0
  2300.       if (pos('/', ImageFile.GSI_i) == 0) & (pos(':', ImageFile.GSI_i) == 0) then
  2301.         ImageFile.GSI_i = ScriptDir'Images/'ImageFile.GSI_i
  2302.       ImageDX.GSI_i = GSI_DX
  2303.       ImageDY.GSI_i = GSI_DY
  2304.     end
  2305.  
  2306.   do GSI_i = 1 to 8
  2307.     if (Do.GSI_i='BothJ') | (Do.GSI_i='BothS') then iterate
  2308.     interpret 'Do'Do.GSI_i' = 0'
  2309.   end
  2310.  
  2311.   do GSI_i = 0 to GroupCount
  2312.     pos = pos.GSI_i
  2313.     option = option.pos
  2314.     if Do.option == 'BothJ' then do
  2315.       DoJulian = pos.GSI_i
  2316.       DoJulianLeft = pos.GSI_i
  2317.     end
  2318.     else if Do.option == 'BothS' then do
  2319.       DoSunrise = pos.GSI_i
  2320.       DoSunset  = pos.GSI_i
  2321.     end
  2322.     else interpret 'Do'Do.option" = '"pos.GSI_i"'"
  2323.   end
  2324.  
  2325.   TopOption = 0
  2326.   do GSI_i = 1 to 8
  2327.     if (Do.GSI_i='BothJ') | (Do.GSI_i='BothS') then iterate
  2328.     if left(value('Do'Do.GSI_i), 1) == 'T' then do
  2329.       TopOption = 1
  2330.       leave
  2331.     end
  2332.   end
  2333.  
  2334.   call WriteData
  2335.  
  2336.   if CalType == 1 then Calendar = Month.Month' 'EnteredYear
  2337.   else Calendar = EnteredYear
  2338.   call bguiwinclose(winID)
  2339.  
  2340.   Mn = right(Month, 2, '0')
  2341.   if DataType(Month) == 'NUM' then call setclip('FWC_CalMonth', Month)
  2342.   if DataType(EnteredYear) == 'NUM' then call setclip('FWC_CalYear', EnteredYear)
  2343.  
  2344.   return
  2345. /**/
  2346.  
  2347. /***//*******  GetSRSS (GS) Subroutine  ***********/
  2348. GetSRSS:
  2349.   parse arg GS_IDay
  2350.  
  2351.   GS_EDay = translate(DateInfo('E', GS_IDay, 'I'), '-', '/')
  2352.   if AdjustDST ~= 0 then do
  2353.     if GS_IDay < StartDST | GS_IDay >= EndDST then call WriteEnv('suncalc/dst', 0)
  2354.     else call WriteEnv('suncalc/dst', 1)
  2355.   end
  2356.   address command Storage'suncalc > 'Storage'SRSS.txt date='GS_EDay' text="$SR $SS"'
  2357.   call open('SRSS', Storage'SRSS.txt')
  2358.     GS_SRSS = readln('SRSS')
  2359.   call close('SRSS')
  2360. return GS_SRSS
  2361. /**/
  2362.  
  2363. /***//*******  GetWidth (GW) Subroutine  ***********/
  2364. GetWidth:
  2365.   parse arg GW_ID
  2366.   if App = 'FW' then do
  2367.     GETOBJECTCOORDS GW_ID
  2368.     Parse Var result . . . GW_width .
  2369.   end
  2370.   else if App == 'PGS' then do
  2371.     SELECTOBJECT OBJECTID GW_ID WINDOW winName
  2372.     GETTEXTOBJ POSITION GW_Temp OBJECTID GW_ID WINDOW winName
  2373.     GW_width = GW_Temp.Right - GW_Temp.Left
  2374.   end
  2375.   return GW_width
  2376. /**/
  2377.  
  2378. /***//*******  HalveBox (HB) Subroutine  ***********/
  2379. HalveBox:
  2380.   parse arg HB_ID
  2381.  
  2382.   if App = 'FW' then do
  2383.     GETOBJECTCOORDS HB_ID
  2384.     parse var result . HB_Left HB_Top HB_Width HB_Height
  2385.     SETOBJECTCOORDS HB_ID 1 HB_Left HB_Top HB_Width HB_Height/2
  2386.   end
  2387.   else if App == 'PGS' then do
  2388.     GETBOX POSITION HB_Coords OBJECTID HB_ID WINDOW winName
  2389.     HB_Bottom = HB_Coords.Top + (HB_Coords.Bottom - HB_Coords.Top) / 2
  2390.     EDITBOX POSITION HB_Coords.Left HB_Coords.Top HB_Coords.Right HB_Bottom OBJECTID HB_ID WINDOW winName
  2391.   end
  2392.  
  2393.   return HB_ID
  2394. /**/
  2395.  
  2396. /***//*******  LibVer (LV) Subroutine  *********/
  2397. LibVer: /* Retrieve the version number of a library */
  2398.   parse arg LV_libname
  2399.   if right(LV_libname,8) ~= '.library' then LV_libname = LV_libname'.library'
  2400.   address command 'version' 'libs:'LV_Libname '>env:LibVer'
  2401.   LV_libver = ReadEnv('LibVer')
  2402.  
  2403.   return LV_libver
  2404. /**/
  2405.  
  2406. /***//*******  MemberID (MI) Subroutine  *********/
  2407. MemberID:
  2408.   parse arg MI_Member, MI_Array, MI_Count, MI_Start
  2409.  
  2410.   if MI_Count == '' then interpret 'MI_Count = 'MI_Array'.Count'
  2411.   if MI_Start == '' then MI_Start = 0
  2412.  
  2413.   if MI_Start == 0 then MI_Count = MI_Count - 1
  2414.   do MI_i = MI_Start to MI_Count
  2415.     if upper(value(MI_Array'.'MI_i)) == upper(MI_Member) then return MI_i
  2416.   end
  2417.   return -1
  2418. /**/
  2419.  
  2420. /***//*******  MiniCalPreCalc (MCPC) Subroutine  *********/
  2421. MiniCalPreCalc:
  2422.   parse arg MCPC_FontType, MCPC_CalWidth
  2423.  
  2424.   Width.MCPC_FontType = 100 * min(1, MCPC_CalWidth / (22 * BoldWidth.Widest))
  2425.   if App == 'FW' then Width.MCPC_FontType = trunc(Width.MCPC_FontType)
  2426.  
  2427.   do MCPC_i = 0 to 9
  2428.     NormalWidth.MCPC_i = NormalWidth.MCPC_i * Width.MCPC_FontType / 100
  2429.     BoldWidth.MCPC_i   = BoldWidth.MCPC_i * Width.MCPC_FontType / 100
  2430.   end
  2431.   NormalWidth.Widest = NormalWidth.Widest * Width.MCPC_FontType / 100
  2432.   BoldWidth.Widest = BoldWidth.Widest * Width.MCPC_FontType / 100
  2433. return
  2434. /**/
  2435.  
  2436. /***//*******  Move (M) Subroutine  ***********/
  2437. Move:
  2438.   parse arg M_ID, M_dX, M_dY
  2439.  
  2440.   if M_ID == 0 then return
  2441.   if App = 'FW' then do
  2442.     GETOBJECTCOORDS M_ID; Parse Var result . M_Coords.Left M_Coords.Top M_Coords.Width M_Coords.Height
  2443.     SETOBJECTCOORDS M_ID 1 (M_Coords.Left + M_dX) (M_Coords.Top + M_dY) M_Coords.Width M_Coords.Height
  2444.   end
  2445.   else if App == 'PGS' then MOVE OFFSET M_dX M_dY OBJECTID M_ID WINDOW winName
  2446.  
  2447.   return
  2448. /**/
  2449.  
  2450. /***//*******  NameOnly (NO) Subroutine  ***********/
  2451. NameOnly:
  2452.   parse arg NO_fontname
  2453.   return substr(NO_fontname, max(lastpos(':', NO_fontname), lastpos('/', NO_fontname)) + 1)
  2454. /**/
  2455.  
  2456. /***//*******  OpenBusy (OB) Subroutine  ***********/
  2457. OpenBusy:
  2458.   parse arg OB_BusyTitle, OB_EventCount
  2459.  
  2460.   Progress = 0
  2461.   OB_ProgressGroup=bguivgroup(,
  2462.         bguiinfo('OB_dummy',,'1B'x||'c'OB_BusyTitle)bguilayout(LGO_FixMinHeight,1)||,
  2463.         bguiprogress('OB_prog2_',,0,OB_EventCount)||,
  2464.         bguihgroup(,
  2465.                 bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
  2466.                 bguibutton('OB_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
  2467.                 bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
  2468.         ,,,,'W'),
  2469.   ,-2,-2)
  2470.  
  2471.   OB_ProgressWindow = bguiwindow(PleaseWait$'...',OB_ProgressGroup,,2,,PubScreen)
  2472.   if bguiwinopen(OB_ProgressWindow) = 0 then call Cleanup
  2473.  
  2474. return OB_ProgressWindow
  2475. /**/
  2476.  
  2477. /***//*******  ParseVariables (PV) Subroutine  ***********/
  2478. ParseVariables:
  2479. parse arg PV_Line
  2480.  
  2481. PV_String = translate(PV_Line,,'=(+-*/,)"'||"'",' ')
  2482. PV_VarString = ''
  2483. PV_Var.      = '00'x
  2484. PV_LongVar   = 4
  2485. PV_LIT       = ''
  2486. PV_Count     = 0
  2487.  
  2488. do PV_i = 1 to words(PV_String)
  2489.   PV_Word = word(PV_String, PV_i)
  2490.   if pos(PV_Word'(', PV_Line) > 0 then iterate
  2491.   if datatype(PV_Word) == 'CHAR' then do
  2492.     if (symbol(PV_Word) == 'LIT') then PV_LIT = PV_LIT''PV_Word', '
  2493.     if (symbol(PV_Word) == 'VAR') | (pos('.', PV_Word) > 0) then do
  2494.       if symbol(PV_Word) == 'VAR' then do
  2495.         PV_LongVar = max(PV_LongVar, length(PV_Word) + 2)
  2496.         if PV_Var.PV_Word == '00'x then do
  2497.           PV_Count = PV_Count + 1
  2498.           PV_Var.PV_Count = PV_Word
  2499.           PV_Var.PV_Word  = value(PV_Word)
  2500.         end
  2501.       end
  2502.       if pos('.', PV_Word) > 0 then do
  2503.         PV_CompoundParts = subword(translate(PV_Word,,'.', ' '), 2)
  2504.         do PV_j = 1 to words(PV_CompoundParts)
  2505.           PV_Subword = word(PV_CompoundParts, PV_j)
  2506.           PV_LongVar = max(PV_LongVar, length(PV_SubWord) + 2)
  2507.           if PV_Var.PV_SubWord == '00'x then do
  2508.             PV_Count = PV_Count + 1
  2509.             PV_Var.PV_Count = PV_SubWord
  2510.             if symbol(PV_Subword) == 'LIT' then PV_Var.PV_SubWord  = 'LIT'
  2511.             else PV_Var.PV_SubWord  = value(PV_SubWord)
  2512.           end
  2513.         end
  2514.       end
  2515.     end
  2516.   end
  2517. end
  2518.  
  2519. do PV_i = 1 to PV_Count
  2520.   PV_Word = PV_Var.PV_i
  2521.   if length(PV_Var.PV_Word) > 50 then PV_Var.PV_Word = left(PV_Var.PV_Word, 50)'...'
  2522.   PV_Var.PV_Word = translate(PV_Var.PV_Word,,'0a'x||'0d'x||'00'x,'bb'x)
  2523.   PV_VarString = PV_VarString''right(PV_Word, PV_LongVar)' = 'PV_Var.PV_Word||'0a'x
  2524. end
  2525.  
  2526. if PV_LIT ~= '' then PV_VarString = right('LIT', PV_LongVar)' = 'strip(PV_LIT, 'B', ' ,')||'0a'x||PV_VarString
  2527. return PV_VarString
  2528. /**/
  2529.  
  2530. /***//*******  PathPart (PP) Subroutine  ***********/
  2531. PathPart:
  2532.   parse arg PP_FileWithPath
  2533.   return left(PP_FileWithPath, max(lastpos(':', PP_FileWithPath), lastpos('/', PP_FileWithPath)))
  2534. /**/
  2535.  
  2536. /***//*******  PrintHighlight (PH) Subroutine  ***********/
  2537. PrintHighlight:
  2538.   parse arg PH_Event
  2539.  
  2540.   /* Fit line(s) into allowable space */
  2541.   PH_Textline         = 0
  2542.   PH_Text.            = ''
  2543.   PH_Text.PH_Textline = PH_Event
  2544.  
  2545.   Do until PH_Text.PH_Nextline == ''
  2546.     PH_AllowedWidth = BoxWidth - 2 * DateOffset - HighlightOffset
  2547.     PH_Nextline = PH_Textline + 1
  2548.     if PH_Textline == 0 then PH_Indent.PH_Textline = 0
  2549.     else PH_Indent.PH_Textline = Width.WidthOfDate1
  2550.     PH_AllowedWidth = PH_AllowedWidth - PH_Indent.PH_Textline
  2551.  
  2552.     if PH_Event == '' then do
  2553.       PH_Text.PH_TextLine = ''
  2554.       iterate
  2555.     end
  2556.     if App == 'FW' & length(PH_Text.PH_Textline) > 37 then do
  2557.       PH_Wordbreak = lastpos(' ', PH_Text.PH_Textline, 37)
  2558.       PH_Text.PH_Nextline = strip(substr(PH_Text.PH_Textline, PH_Wordbreak)' 'PH_Text.PH_Nextline)
  2559.       PH_Text.PH_Textline = strip(left(PH_Text.PH_Textline, PH_Wordbreak))
  2560.     end
  2561.     PH_ID = PrintText(1, 1, Highlight, 'N', Color.Highlight, Width.Highlight, PH_Text.PH_Textline)
  2562.     if App == 'FW' then redraw
  2563.     PH_TextWidth.PH_Textline = GetWidth(PH_ID)
  2564.     if App == 'FW' then DELETEOBJECT PH_ID
  2565.     else if App == 'PGS' then do
  2566.       SELECTOBJECT ObjectID PH_ID WINDOW winName
  2567.       DELETEOBJECT ObjectID PH_ID WINDOW winName
  2568.     end
  2569.  
  2570.     PH_NeededCompression.PH_Textline = min(1, PH_AllowedWidth/PH_TextWidth.PH_Textline)
  2571.     if (PH_NeededCompression.PH_Textline < MinWidth/100) & (Words(PH_Text.PH_Textline) > 1) then do
  2572.       /* Move last word to next line */
  2573.       PH_Wordbreak     = lastpos(' ', PH_Text.PH_Textline)
  2574.       PH_Text.PH_Nextline = strip(substr(PH_Text.PH_Textline, PH_Wordbreak)' 'PH_Text.PH_Nextline)
  2575.       PH_Text.PH_Textline = strip(left(PH_Text.PH_Textline, PH_Wordbreak))
  2576.     end
  2577.     else if PH_Text.PH_Nextline ~= '' then PH_Textline = PH_Textline + 1
  2578.  
  2579.   end
  2580.   PH_LineCount = PH_Textline
  2581.  
  2582.   do PH_TextLine = 0 to PH_LineCount
  2583.     if PH_Text.PH_TextLine ~= '' then do
  2584.       TextLeft = BoxLeft + DateOffset + HighlightOffset * (DailyHLCount * Height.Highlight < Height.Date * TextBase)
  2585.       PH_TextTop = BoxTop + DailyHLCount * Height.Highlight
  2586.       PH_Width = PH_NeededCompression.PH_Textline * Width.Highlight
  2587.       if App == 'FW' then PH_Width = min(max(trunc(PH_Width), 4), 255)
  2588.       call PrintText(TextLeft + PH_Indent.PH_TextLine, PH_TextTop, Highlight, 'N', TextColor, PH_Width, PH_Text.PH_TextLine)
  2589.     end
  2590.     if PH_TextLine ~= PH_LineCount then DailyHLCount = DailyHLCount + 1
  2591.   end
  2592.   return
  2593. /**/
  2594.  
  2595. /***//*******  PrintOption (PO) Subroutine  ***********/
  2596. PrintOption:
  2597.   parse arg PO_Location
  2598.  
  2599.   PO_ID = PrintText(BoxLeft + DateOffset, BoxTop + (BHeight - Height.Extras) * (left(PO_Location, 1) ~= 'T'), Extras, 'N', DO_PrintColor, Width.Extras, DO_Text2Print)
  2600.   if right(PO_Location, 1) == 'C' then call CenterText(PO_ID, BoxLeft + BoxWidth / 2, 0, min(1, BoxWidth/GetWidth(PO_ID)))
  2601.   if right(PO_Location, 1) == 'R' then call RightText(PO_ID, BoxLeft + BoxWidth - 2 * DateOffset)
  2602.  
  2603.   return PO_ID
  2604. /**/
  2605.  
  2606. /***//*******  PrintText (PT) Subroutine  ***********/
  2607. PrintText:
  2608.   parse arg PT_Left, PT_Top, PT_FontType, PT_Style, PT_Color, PT_Width, PT_Text
  2609.  
  2610.   if upper(PT_Style) == 'N' then PT_Font = Font.PT_FontType
  2611.   else PT_Font = Bold.PT_FontType
  2612.  
  2613.   if App == 'FW' then do
  2614.     if left(PT_Text, 1) == '"' then PT_Text = '""'PT_Text
  2615.     PT_Top = PT_Top + TextAdj * Height.PT_FontType
  2616.     TEXTBLOCKTYPEPREFS SIZE FSize.PT_FontType WIDTH trunc(PT_Width) COLOR '"'PT_Color'"' FONT PT_Font
  2617.     DRAWTEXTBLOCK 1 trunc(PT_Left, 4) trunc(PT_Top, 4) PT_Text; PT_id = result
  2618.   end
  2619.   else if App == 'PGS' then do
  2620.     DRAWTEXTOBJ PT_Left PT_Top WINDOW winName; PT_id = result
  2621.     SELECTTEXT AT PT_Left PT_Top WINDOW winName
  2622.     BEGINCOMMANDCAPTURE
  2623.       SETLEADING RELATIVE 100
  2624.       SETTYPESIZE FSize.PT_FontType WINDOW winName
  2625.       SETTYPEWIDTH PT_Width WINDOW winName
  2626.       SETFONT PT_Font WINDOW winName
  2627.       SETCOLORSTYLE '"'PT_Color'"' COLORNUMBER 0 FILL TEXT WINDOW winName
  2628.     ENDCOMMANDCAPTURE
  2629.     if pos('"', PT_Text) > 0 then do
  2630.       call open('IFile', Storage'Text2Insert.txt', 'W')
  2631.         call WriteLn('IFile', PT_Text)
  2632.       call close('IFile')
  2633.       INSERTTEXT FILE Storage'Text2Insert.txt' FILTER ASCII WINDOW winName
  2634.     end
  2635.     else INSERT '"'PT_Text'"' WINDOW winName
  2636.   end
  2637.   return PT_id
  2638. /**/
  2639.  
  2640. /***//*******  ReadData (RD) Subroutine  ***********/
  2641. ReadData:
  2642.   call UpdateBusy(Req, 1)
  2643.   RD_VarCount   = 0
  2644.   RD_ColorCount = 0
  2645.   RD_FontCount  = 0
  2646.   RD_ICCount    = 0
  2647.   RD_SL         = 0
  2648.   RD_Var.       = ''
  2649.   RD_UpdateVars = 0
  2650.   RD_Progress   = -1
  2651.   PrefsFile     = ''
  2652.   PrefsName     = ''
  2653.   VarNameMaxLn  = 0
  2654.  
  2655.   if open('DataFile', ScriptDir''ChangesFile) then do
  2656.     DataFile = readch('DataFile', 65535)
  2657.     call close('DataFile')
  2658.     call openv('DataFile')
  2659.       RD_DataVersion = readvln('DataFile')
  2660.       if pos('Dataversion', RD_DataVersion) == 0 then do
  2661.         call seekv('DataFile', 0, 'B')
  2662.         RD_UpdateVars = 1
  2663.       end
  2664.       else if word(RD_DataVersion, 2) ~= word(sourceline(4), 3) then RD_UpdateVars = 1
  2665.       do until eofv('DataFile')
  2666.         RD_Ln = ReadVLn('DataFile')
  2667.         if RD_Ln = '' then iterate
  2668.         RD_VarName = strip(word(RD_Ln, 1))
  2669.         VarNameMaxLn = max(VarNameMaxLn, length(RD_VarName))
  2670.         if right(RD_VarName, 1) == '$' then iterate
  2671.         if RD_VarName == 'PrefsFile' then do
  2672.           interpret RD_Ln
  2673.           if PrefsFile ~= 'Default' then do
  2674.             if open('UserFile', PrefsFile) then do
  2675.               do until eof('UserFile')
  2676.                 RD_VarLine = strip(ReadLn('UserFile'))
  2677.                 RD_VarName = upper(strip(word(RD_VarLine, 1)))
  2678.                 if left(RD_VarLine, 15) == '/* End Pass One' then leave
  2679.                 if (right(RD_VarName, 1) == '$') then interpret RD_VarLine
  2680.               end
  2681.               call close('UserFile')
  2682.             end
  2683.           end
  2684.           iterate
  2685.         end
  2686.         RD_VarDone = 0
  2687.         RD_VarStem = upper(left(RD_VarName, pos('.', RD_VarName)))
  2688.         RD_Var.RD_SL = RD_VarName
  2689.         RD_SL = RD_SL + 1
  2690.         if RD_VarStem ~= 'IMAGECLASS.' then interpret RD_Ln
  2691.         if (upper(left(RD_VarName, 7)) == 'STORAGE') |,
  2692.            (upper(left(RD_VarName, 7)) == 'MARGIN.') |,
  2693.            (upper(RD_VarName) == 'PREFSFILE') then iterate
  2694.         if (upper(left(RD_VarName, 2)) == 'DO') & (upper(RD_VarName) ~= 'DOHIDE') & (upper(RD_VarName) ~= 'DOSHANGHAI') then RD_VarDone = 1
  2695.         if RD_VarStem == 'IMAGECLASS.' then do
  2696.           ImageClass.RD_ICCount = upper(substr(RD_VarName, 12))
  2697.           interpret 'ImageFile.'RD_ICCount' = 'strip(substr(RD_Ln, pos('=', RD_Ln) + 1))
  2698.           RD_ICCount = RD_ICCount + 1
  2699.           VarName.RD_VarCount = RD_VarName
  2700.           RD_VarCount = RD_VarCount + 1
  2701.           RD_VarDone = 1
  2702.         end
  2703.         if (RD_VarStem == 'ALTCOLOR.') |,
  2704.            (RD_VarStem == 'BACKGROUND.') |,
  2705.            (RD_VarStem == 'COLOR.') |,
  2706.            (RD_VarStem == 'LINE.') then do
  2707.           if (MemberID(value(RD_VarName), 'ColorList') == -1) then do
  2708.             if (value(RD_VarName) == '<'Clear$'>') & (RD_VarStem == 'BACKGROUND.') then nop
  2709.             else do
  2710.               call AddMsg('W', value(RD_VarName)" can't be found; "ColorList.0" used instead.")
  2711.               interpret RD_VarName' = "'ColorList.0'"'
  2712.             end
  2713.           end
  2714.           ColorName.RD_ColorCount = RD_VarName
  2715.           RD_ColorCount = RD_ColorCount + 1
  2716.           RD_VarDone = 1
  2717.         end
  2718.         if (RD_VarStem == 'FONT.') | (RD_VarStem == 'BOLD.') then do
  2719.           FontName.RD_FontCount = RD_VarName
  2720.           RD_FontCount = RD_FontCount + 1
  2721.           RD_VarDone = 1
  2722.         end
  2723.         if RD_VarDone == 0 then do
  2724.           VarName.RD_VarCount = RD_VarName
  2725.           RD_VarCount = RD_VarCount + 1
  2726.         end
  2727.       end
  2728.     call closev('DataFile')
  2729.   end
  2730.   else do
  2731.     call AddMsg('E', 'Unable to open 'ScriptDir''ChangesFile)
  2732.     call Cleanup
  2733.   end
  2734.  
  2735.   if RD_UpdateVars == 1 then do /* See if new default variables were added */
  2736.     call open('Temp', FullCallPath)
  2737.       FileOffset = 120000
  2738.       call seek('Temp', FileOffset, 'B')
  2739.       do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  2740.         PrevOffset = FileOffset
  2741.         Chunk = readch('Temp', 65535)
  2742.         EndPos = pos('VarList:'||'0a'x, Chunk)
  2743.         if EndPos == 0 then FileOffset = seek('Temp', -10, 'C')
  2744.       end
  2745.       call seek('Temp', FileOffset + EndPos + 8, 'B')
  2746.       DefaultVariables = readch('Temp', 65535)
  2747.     call close('Temp')
  2748.     call openv('DefaultVariables')
  2749.       do forever
  2750.         RD_VarDone = 0
  2751.         RD_VarLine = strip(readvln('DefaultVariables'))
  2752.         RD_VarName = strip(word(RD_VarLine, 1))
  2753.         RD_VarStem = upper(left(RD_VarName, pos('.', RD_VarName)))
  2754.         if RD_VarLine == 'return' then leave
  2755.         if (upper(left(RD_VarName, 7)) == 'STORAGE') |,
  2756.            (upper(left(RD_VarName, 7)) == 'MARGIN.') then iterate
  2757.         if upper(left(RD_VarName, 2)) == 'DO' then do
  2758.           if (upper(RD_VarName ~= 'DOHIDE')) & (upper(RD_VarName ~= 'DOSHANGHAI')) then do
  2759.             if MemberID(RD_VarName, 'RD_Var', RD_SL) == -1 then do
  2760.               interpret RD_VarLine
  2761.               RD_Var.RD_SL = RD_VarName
  2762.               RD_SL = RD_SL + 1
  2763.             end
  2764.           end
  2765.           RD_VarDone = 1
  2766.         end
  2767.         if (RD_VarStem == 'ALTCOLOR.') |,
  2768.            (RD_VarStem == 'BACKGROUND.') |,
  2769.            (RD_VarStem == 'COLOR.') |,
  2770.            (RD_VarStem == 'LINE.') then do
  2771.           if MemberID(RD_VarName, 'ColorName', RD_ColorCount) == -1 then do
  2772.             interpret RD_VarLine
  2773.             RD_Var.RD_SL = RD_VarName
  2774.             RD_SL = RD_SL + 1
  2775.             ColorName.RD_ColorCount = RD_VarName
  2776.             RD_ColorCount = RD_ColorCount + 1
  2777.           end
  2778.           RD_VarDone = 1
  2779.         end
  2780.         if (RD_VarStem == 'FONT.') | (RD_VarStem == 'BOLD.') then do
  2781.           if MemberID(RD_VarName, 'FontName', RD_FontCount) == -1 then do
  2782.             interpret RD_VarLine
  2783.             RD_Var.RD_SL = RD_VarName
  2784.             RD_SL = RD_SL + 1
  2785.             FontName.RD_FontCount = RD_VarName
  2786.             RD_FontCount = RD_FontCount + 1
  2787.           end
  2788.           RD_VarDone = 1
  2789.         end
  2790.         if RD_VarDone == 0 then do
  2791.           if MemberID(RD_VarName, 'VarName', RD_VarCount) == -1 then do
  2792.             interpret RD_VarLine
  2793.             RD_Var.RD_SL = RD_VarName
  2794.             RD_SL = RD_SL + 1
  2795.             VarName.RD_VarCount = RD_VarName
  2796.             RD_VarCount = RD_VarCount + 1
  2797.           end
  2798.         end
  2799.       end
  2800.     call closev('DefaultVariables')
  2801.   end
  2802.  
  2803.   if PrefsFile == '' then do
  2804.     if exists(ScriptDir''FWCData) then PrefsFile = ScriptDir''FWCData
  2805.     else PrefsFile = 'Default'
  2806.   end
  2807.   if PrefsName == '' then PrefsName = PrefsFile
  2808.  
  2809.   RD_Var.COUNT     = RD_SL
  2810.   VarName.COUNT    = RD_VarCount
  2811.   ColorName.COUNT  = RD_ColorCount
  2812.   FontName.COUNT   = RD_FontCount
  2813.   ImageClass.COUNT = RD_ICCount
  2814.  
  2815.   ColorName = ColorName.0
  2816.   FontName  = FontName.0
  2817.   VarName   = VarName.0
  2818.   if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
  2819.     IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
  2820.     VarVal = ImageFile.IC
  2821.   end
  2822.   else VarVal = Value(VarName)
  2823.  
  2824.   if upper(Orientation) == 'WIDE' then OrientChoice = 0
  2825.   else OrientChoice = 1
  2826.  
  2827.   call UpdateBusy(Req, 1)
  2828.   if (exists(SunCalcPath'suncalc')) & (~exists(Storage'suncalc')) then address command 'copy 'SunCalcPath'suncalc 'Storage
  2829.  
  2830.   call UpdateBusy(Req, 1)
  2831.   if (exists(GfxAppPath''GfxApp)) & (~exists(Storage''GfxApp)) then address command 'copy 'GfxAppPath''GfxApp' 'Storage
  2832.   if ~exists(Storage''GfxApp) then DoImages = 0
  2833.  
  2834.   if PhaseLib ~= 1 then DoPhases = 0
  2835.   return
  2836. /**/
  2837.  
  2838. /***//*******  ReadEnv (RE) Subroutine  ***********/
  2839. ReadEnv: PROCEDURE
  2840.   parse arg file
  2841.  
  2842.   if open('Temp', 'ENV:'file) then do
  2843.     val = strip(readch('Temp', 65535), 'B', ' '||'0a'x)
  2844.     call close('Temp')
  2845.   end
  2846.   else val = ''
  2847.   return val
  2848. /**/
  2849.  
  2850. /***//*******  ReplaceString (RS) Subroutine  ***********/
  2851. ReplaceString: PROCEDURE
  2852.   parse arg old, new, string
  2853.  
  2854.   if pos(old, string) > 0 then do
  2855.     parse var string begin(old)end
  2856.     return begin || new || ReplaceString(old, new, end)
  2857.   end
  2858.  
  2859.   return string
  2860. /**/
  2861.  
  2862. /***//*******  RightText (RT) Subroutine  ***********/
  2863. RightText:
  2864.   parse arg RT_id, RT_RightEdge
  2865.  
  2866.   if App = 'FW' then do
  2867.     GETOBJECTCOORDS RT_id; Parse Var result . . RT_Text.Bottom RT_Text.Width RT_Text.Height
  2868.     RT_Text.Left = RT_RightEdge - RT_Text.Width
  2869.     SETOBJECTCOORDS RT_id 1 RT_Text.Left RT_Text.Bottom RT_Text.Width RT_Text.Height
  2870.   end
  2871.   else if App == 'PGS' then do
  2872.     GETTEXTOBJ POSITION RT_Text OBJECTID RT_id WINDOW winName
  2873.     RT_Text.Width = RT_Text.Right - RT_Text.Left
  2874.     RT_Text.Left = RT_RightEdge - RT_Text.Width
  2875.     EDITTEXTOBJ POSITION RT_Text.Left RT_Text.Top (RT_Text.Left + RT_Text.Width) RT_Text.Bottom OBJECTID RT_id WINDOW winName
  2876.   end
  2877.   return RT_id
  2878. /**/
  2879.  
  2880. /***//*******  ReadTranslations (RTr) Subroutine  ***********/
  2881. ReadTranslations:
  2882.   if exists(PrefsFile) then do
  2883.     if open('DataFile', PrefsFile) then do
  2884.       do until eof('DataFile')
  2885.         RTr_Ln = ReadLn('DataFile')
  2886.         RTr_Var = upper(word(RTr_Ln, 1))
  2887.         if right(RTr_Var, 1) == '$' then interpret RTr_Ln
  2888.         else if pos('/* End Pass One', RTr_Ln) > 0 then leave
  2889.       end
  2890.       call close('DataFile')
  2891.     end
  2892.   end
  2893.  
  2894.   Month.1  = January$
  2895.   Month.2  = February$
  2896.   Month.3  = March$
  2897.   Month.4  = April$
  2898.   Month.5  = May$
  2899.   Month.6  = June$
  2900.   Month.7  = July$
  2901.   Month.8  = August$
  2902.   Month.9  = September$
  2903.   Month.10 = October$
  2904.   Month.11 = November$
  2905.   Month.12 = December$
  2906.  
  2907.   return
  2908. /**/
  2909.  
  2910. /***//*******  SaveVariable (SV) Subroutine  ***********/
  2911. SaveVariable:
  2912.   parse arg SV_OutFile, SV_Variable, SV_Value
  2913.  
  2914.   SV_Cmd = SV_Variable' = 'SV_Value
  2915.   call WriteLn(SV_OutFile, SV_Cmd)
  2916.   interpret SV_Cmd
  2917.  
  2918.   return
  2919. /**/
  2920.  
  2921. /***//*******  SetFill (SF) Subroutine  ***********/
  2922. SetFill:
  2923.   parse arg SF_ID, SF_StrokeColor, SF_FillColor
  2924.  
  2925.   BEGINCOMMANDCAPTURE
  2926.     SETSTROKEWEIGHT '0.3pt' STROKENUMBER 0 OBJECT OBJECTID SF_ID WINDOW winName
  2927.     SETCOLORSTYLE '"'SF_StrokeColor'"' STROKENUMBER 0 OBJECT OBJECTID SF_ID WINDOW winName
  2928.     FILLED 'ON'
  2929.     SETCOLORSTYLE '"'SF_FillColor'"' FILL OBJECT OBJECTID SF_ID WINDOW winName
  2930.   ENDCOMMANDCAPTURE
  2931.   return
  2932. /**/
  2933.  
  2934. /***//*******  SetHighlights (SH) Subroutine  ***********/
  2935. SetHighlights:
  2936. /* The algorithm for calculating Easter is due to J.-M. Oudin (1940) and is        */
  2937. /* reprinted in the Explanatory Supplement to the Astronomical Almanac, ed. P. K.  */
  2938. /* Seidelmann (1992). See Chapter 12, "Calendars", by L. E. Doggett.               */
  2939. /*                                                                                 */
  2940. /* I obtained the algorithm from the US Naval Observatory web site                 */
  2941.  
  2942.   SettingHighlights = 1
  2943.   SH_Progress = -2
  2944.   if EasterKnown ~= 1 then do
  2945.     SH_century = trunc(Year / 100)
  2946.     SH_n = trunc(Year - 19 * trunc(Year / 19))
  2947.     SH_k = trunc((SH_century - 17) / 25)
  2948.     SH_i = SH_century - trunc(SH_century / 4) - trunc((SH_century - SH_k) / 3) + 19 * SH_n + 15
  2949.     SH_i = SH_i - 30 * trunc(SH_i / 30)
  2950.     SH_i = SH_i - trunc(SH_i / 28) * (1 - trunc(SH_i / 28) * trunc(29 / (SH_i + 1)) * trunc((21 - SH_n) / 11))
  2951.     SH_j = Year + trunc(Year / 4) + SH_i + 2 - SH_century + trunc(SH_century / 4)
  2952.     SH_j = SH_j - 7 * trunc(SH_j / 7)
  2953.     SH_l = SH_i - SH_j
  2954.     SH_EasterMonth  = 3 + trunc((SH_l + 40 ) / 44)
  2955.     SH_EasterDay    = SH_l + 28 - 31 * trunc(SH_EasterMonth / 4)
  2956.     EasterSerial = DateInfo('I', Year'0'SH_EasterMonth''right(SH_EasterDay, 2, '0'), 'S')
  2957.     EasterKnown  = 1
  2958.   end
  2959.   Highlight. = ''
  2960.   Image.     = ''
  2961.  
  2962.   if PrefsFile ~= 'Default' then do
  2963.     call open('DataFile', PrefsFile)
  2964.     do forever
  2965.       if eof('DataFile') then leave
  2966.       if pos('/* End Pass One', readln('DataFile')) > 0 then do
  2967.         do until eof('DataFile')
  2968.           SH_Ln = ReadLn('DataFile')
  2969.           SH_Ln2 = left(SH_Ln, 2)
  2970.           if upper(left(SH_Ln, 14)) == 'CALCULATEEDATE' then interpret 'call 'SH_Ln
  2971.           if (SH_Ln2 == Mn) | (SH_Ln2 == '13') then do
  2972.             SH_Progress = -SH_Progress
  2973.             call UpdateBusy(Req, SH_Progress)
  2974.             select
  2975.               when upper(substr(SH_Ln, 3, 13)) == 'CALCULATEDATE' then interpret 'call 'substr(SH_Ln, 3)
  2976.               when upper(substr(SH_Ln, 3, 9)) == 'HIGHLIGHT' then call AssignHighlight(substr(SH_Ln, 3))
  2977.               when upper(substr(SH_Ln, 3, 5)) == 'IMAGE' then call AssignImage(substr(SH_Ln, 3))
  2978.               when upper(substr(SH_Ln, 3, 14)) == 'CALCULATEIMAGE' then interpret 'call 'substr(SH_Ln, 3)
  2979.               otherwise do
  2980.                 call AddMsg('W', 'Check the keyword in the following line of your FWCalendar.data file:')
  2981.                 call AddMsg('W', '  'SH_Ln)
  2982.                 ListHighlightData = 1
  2983.               end
  2984.             end
  2985.           end
  2986.         end
  2987.       end
  2988.     end
  2989.     call close('DataFile')
  2990.   end
  2991.  
  2992.   if DoEaster == 1 then call AssignHighlight(SH_EasterMonth, SH_EasterDay, Easter$'#')
  2993.   if sign(SH_Progress) == 1 then call UpdateBusy(Req, -SH_Progress)
  2994.   SettingHighlights = 0
  2995. return
  2996. /**/
  2997.  
  2998. /***//*******  Syntax () Subroutine  ***********/
  2999. Syntax:
  3000.   signal off syntax
  3001.  
  3002.   ErrorLine  = SIGL
  3003.   SourceLine = strip(SourceLine(ErrorLine))
  3004.  
  3005.   call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
  3006.   call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
  3007.   call AddMsg('E', ParseVariables(SourceLine))
  3008.  
  3009.   call Cleanup
  3010.   exit
  3011. /**/
  3012.  
  3013. /***//*******  UpdateBusy (UB) Subroutine  ***********/
  3014. UpdateBusy:
  3015.   parse arg UB_ReqWin, UB_ProgressMade
  3016.  
  3017.   if UB_ReqWin == 0 then return
  3018.   Progress = Progress + UB_ProgressMade
  3019.  
  3020.   call bguiset(obj.OB_prog2_,UB_ReqWin,PROGRESS_Done,Progress)
  3021.   if bguiwinevent(UB_ReqWin,'ID') == id.OB_cancel_ then call Cleanup
  3022.  
  3023.   return
  3024. /**/
  3025.  
  3026. /***//*******  VIO Routines () Subroutine  ***********/
  3027. /***//** OpenV() **/
  3028. OpenV:
  3029.   parse arg VIO_Variable
  3030.  
  3031.   if Open.VIO_Variable ~= 1 then do
  3032.     Open.VIO_Variable = 1
  3033.     Pointer.VIO_Variable = 1
  3034.     EOF.VIO_Variable = 0
  3035.     return 1
  3036.   end
  3037.   else return 0
  3038. /**/
  3039.  
  3040. /***//** CloseV() **/
  3041. CloseV:
  3042.   parse arg VIO_Variable
  3043.  
  3044.   If Open.VIO_Variable == 0 then return 0
  3045.   Open.VIO_Variable = 0
  3046.   return 1
  3047. /**/
  3048.  
  3049. /***//** SeekV() **/
  3050. SeekV:
  3051.   parse arg VIO_Variable, VIO_Offset, VIO_Anchor
  3052.  
  3053.   if Open.VIO_Variable == 1 then do
  3054.     VIO_Anchor = upper(left(VIO_Anchor, 1))
  3055.  
  3056.     VIO_Value = Value(VIO_Variable)
  3057.     select
  3058.       when VIO_Anchor == 'B' then Pointer.VIO_Variable = VIO_Offset
  3059.       when VIO_Anchor == 'E' then Pointer.VIO_Variable = length(VIO_Value) + VIO_Offset
  3060.       otherwise Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Offset
  3061.     end
  3062.  
  3063.     if Pointer.VIO_Variable > length(VIO_Value) then Pointer.VIO_Variable = length(VIO_Value) + 1
  3064.     if Pointer.VIO_Variable == 0 then Pointer.VIO_Variable = 1
  3065.     return Pointer.VIO_Variable
  3066.   end
  3067.   else return 0
  3068. /**/
  3069.  
  3070. /***//** ReadVCh() **/
  3071. ReadVCh:
  3072.   parse arg VIO_Variable, VIO_Length
  3073.  
  3074.   if VIO_Length == '' then VIO_Length = 1
  3075.  
  3076.   if Open.VIO_Variable == 1 then do
  3077.     if EOF.VIO_Variable == 0 then do
  3078.       VIO_Value = Value(VIO_Variable)
  3079.       VIO_Ret = substr(VIO_Value, Pointer.VIO_Variable, VIO_Length)
  3080.       Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Length
  3081.       if Pointer.VIO_Variable > length(VIO_Value) then EOF.VIO_Variable = 1
  3082.       else EOF.VIO_Variable = 0
  3083.     end
  3084.     else VIO_Ret = ''
  3085.   end
  3086.   else VIO_Ret = ''
  3087.  
  3088.   return VIO_Ret
  3089. /**/
  3090.  
  3091. /***//** ReadVLn(RV) **/
  3092. ReadVLn:
  3093.   parse arg VIO_Variable, VIO_Count, VIO_SepChar
  3094.  
  3095.   if VIO_Count == '' then VIO_Count = 1
  3096.   if VIO_SepChar == '' then VIO_SepChar = '0a'x
  3097.  
  3098.   if Open.VIO_Variable == 1 then do
  3099.     VIO_Value = Value(VIO_Variable)
  3100.     VIO_Ret   = ''
  3101.     do VIO_i = 1 to VIO_Count
  3102.       VIO_LF = pos('0a'x, VIO_Value, Pointer.VIO_Variable)
  3103.       if VIO_LF > 0 then do
  3104.         VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable, VIO_LF - Pointer.VIO_Variable)
  3105.         Pointer.VIO_Variable = VIO_LF + 1
  3106.         if VIO_LF = length(VIO_Value) then EOF.VIO_Variable = 1
  3107.         else EOF.VIO_Variable = 0
  3108.       end
  3109.       else do
  3110.         if Pointer.VIO_Variable < length(VIO_Value) then do
  3111.           VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable)
  3112.           Pointer.VIO_Variable = length(VIO_Value) + 1
  3113.           EOF.VIO_Variable = 1
  3114.         end
  3115.       end
  3116.       if EOF.VIO_Variable == 1 then leave
  3117.       if VIO_i ~= VIO_Count then VIO_Ret = VIO_Ret''VIO_SepChar
  3118.     end
  3119.   end
  3120.   else VIO_Ret = ''
  3121.  
  3122.   return VIO_Ret
  3123. /**/
  3124.  
  3125. /***//** WriteVCh() **/
  3126. WriteVCh:
  3127.   parse arg VIO_Variable, VIO_String, VIO_Option
  3128.  
  3129.   VIO_Value  = Value(VIO_Variable)
  3130.   VIO_Option = upper(left(VIO_Option, 1))
  3131.   VIO_Length = length(VIO_Value)
  3132.   if VIO_Option == 'C' then do
  3133.     VIO_Value = Insert(VIO_String, VIO_Value, Pointer.VIO_Variable - 1)
  3134.     Pointer.VIO_Variable = Pointer.VIO_Variable + length(VIO_String)
  3135.   end
  3136.   else if VIO_Option == 'B' then do
  3137.     VIO_Value = VIO_String''VIO_Value
  3138.     Pointer.VIO_Variable = length(VIO_String) + 1
  3139.   end
  3140.   else do
  3141.     VIO_Value = VIO_Value''VIO_String
  3142.     Pointer.VIO_Variable = length(VIO_Value)
  3143.   end
  3144.   interpret VIO_Variable'= VIO_Value'
  3145.   if length(VIO_Value) = VIO_Length + length(VIO_String) then VIO_Ret = length(VIO_String)
  3146.   else VIO_Ret = 0
  3147.  
  3148.   return VIO_Ret
  3149. /**/
  3150.  
  3151. /***//** WriteVLn() **/
  3152. WriteVLn:
  3153.   parse arg VIO_Variable, VIO_String, VIO_Option
  3154.  
  3155.   return WriteVCh(VIO_Variable, VIO_String||'0a'x, VIO_Option)
  3156. /**/
  3157.  
  3158. /***//** EOFV() **/
  3159. EOFV:
  3160.   parse arg VIO_Variable
  3161.  
  3162.   if Open.VIO_Variable == 1 then return EOF.VIO_Variable
  3163.   else return 1
  3164. /**/
  3165. /**/
  3166.  
  3167. /***//*******  WriteData (WD) Subroutine  ***********/
  3168. WriteData:
  3169.   if open('DataFile', ScriptDir''ChangesFile, 'W') then do
  3170.     call writeln('DataFile', 'Dataversion 'word(sourceline(4), 3))
  3171.     call writeln('DataFile', "PrefsFile = '"PrefsFile"'")
  3172.     do WD_i = 0 to RD_SL - 1
  3173.       WD_VarName = RD_Var.WD_i
  3174.       if upper(left(WD_VarName, pos('.', WD_VarName))) == 'IMAGECLASS.' then do
  3175.         WD_IC = MemberID(upper(substr(WD_VarName, 12)), 'ImageClass')
  3176.         WD_Value = ImageFile.WD_IC
  3177.       end
  3178.       else WD_Value = Value(WD_VarName)
  3179.       if (datatype(WD_Value) == 'CHAR') then do
  3180.         if pos("'", WD_Value) ~= 0 then WD_Value = '"'WD_Value'"'
  3181.         else WD_Value = "'"WD_Value"'"
  3182.       end
  3183.       call writeln('DataFile', WD_VarName' = 'WD_Value)
  3184.     end
  3185.     call close('DataFile')
  3186.   end
  3187.   else do
  3188.     call AddMsg('E', 'Unable to create 'ScriptDir''ChangesFile)
  3189.     call Cleanup
  3190.   end
  3191.  
  3192.   return
  3193. /**/
  3194.  
  3195. /***//*******  WriteEnv (WE) Subroutine  ***********/
  3196. WriteEnv: PROCEDURE
  3197.   parse arg file var
  3198.  
  3199.   if open('Temp', 'ENV:'file, 'W') then call writech('Temp', var)
  3200.   return close('Temp')
  3201. /**/
  3202.  
  3203. /***//*******  InitializeVariables () Subroutine  *********/
  3204. InitializeVariables:
  3205.   ColorVars         = 'color. line. background.'
  3206.   CountJulian       = 0
  3207.   CountJulianLeft   = 0
  3208.   CountSunRise      = 0
  3209.   CountSunSet       = 0
  3210.   CountPhases       = 0
  3211.   Error             = 0
  3212.   esc               = "1B"x
  3213.   FSize.            = 10
  3214.   FWCData           = 'FWCalendar.data'
  3215.   ChangesFile       = 'FWC.dat'
  3216.   HighlightCount    = 0
  3217.   ImageClass.Count  = 0
  3218.   ImageCount        = 0
  3219.   ImageSize.        = ''
  3220.   ImageType.        = ''
  3221.   ImageWidth.       = 0
  3222.   ImageHeight.      = 0
  3223.   LF                = '0a'x
  3224.   MoonPhase.        = ''
  3225.   NULL              = '00'x
  3226.   OB_ProgressWindow = ''
  3227.   PatVar            = '#?.(data|prefs)'
  3228.   Req               = 0
  3229.   Storage           = 'RAM:FWC/'
  3230.   Text.             = ''
  3231.   TextAdj           = 0.77
  3232.   TTextArea         = 0.15
  3233.   WTextArea         = 0.20
  3234.   UserPrefs         = ''
  3235.   Width.            = 100
  3236.   Spc               =' '
  3237.   NormalWidth.Spc  = 0
  3238.   BoldWidth.Spc    = 0
  3239.  
  3240.   PGSFilter.     = ''
  3241.   PGSFilter.ILBM = 'IFFILBM'
  3242.   PGSFilter.JFIF = 'JPEG'
  3243.   PGSFilter.POST = 'IllustratorEPS'
  3244.  
  3245.   Action.0       = 'MX_EnableButton'
  3246.   Action.1       = 'MX_DisableButton'
  3247.   GroupCount     = 4
  3248.  
  3249.   pos.0 = 'BL' ; grp.0 = 'obj.bottomleft_'
  3250.   pos.1 = 'BC' ; grp.1 = 'obj.bottomcenter_'
  3251.   pos.2 = 'BR' ; grp.2 = 'obj.bottomright_'
  3252.   pos.3 = 'TC' ; grp.3 = 'obj.topcenter_'
  3253.   pos.4 = 'TR' ; grp.4 = 'obj.topright_'
  3254.  
  3255.   Do.1 = 'Phases'     ; MXPos.Phases     = 1
  3256.   Do.2 = 'Weeknumber' ; MXPos.Weeknumber = 2
  3257.   Do.3 = 'Julian'     ; MXPos.Julian     = 3
  3258.   Do.4 = 'JulianLeft' ; MXPos.JulianLeft = 4
  3259.   Do.5 = 'BothJ'      ; MXPos.BothJ      = 5
  3260.   Do.6 = 'Sunrise'    ; MXPos.Sunrise    = 6
  3261.   Do.7 = 'Sunset'     ; MXPos.Sunset     = 7
  3262.   Do.8 = 'BothS'      ; MXPos.BothS      = 8
  3263.  
  3264.   if App == 'FW' then do
  3265.     DefaultFont = 'SoftSans'
  3266.     DefaultBold = 'SoftSans_Bold'
  3267.   end
  3268.   else if App == 'PGS' then do
  3269.     DefaultFont = 'PageStream-Normal'
  3270.     DefaultBold = 'PageStream-Normal'
  3271.   end
  3272.  
  3273.   Date      = 0
  3274.   Weekday   = 1
  3275.   Header    = 2
  3276.   MiniCal   = 3
  3277.   FYMiniCal = 4
  3278.   Highlight = 5
  3279.   Extras    = 6
  3280.   FontTypes = 6
  3281.  
  3282.   D.0 = 'Sunday'
  3283.   D.1 = 'Monday'
  3284.   D.2 = 'Tuesday'
  3285.   D.3 = 'Wednesday'
  3286.   D.4 = 'Thursday'
  3287.   D.5 = 'Friday'
  3288.   D.6 = 'Saturday'
  3289.  
  3290.   MonthLength.1  = 31
  3291.   MonthLength.2  = 28
  3292.   MonthLength.3  = 31
  3293.   MonthLength.4  = 30
  3294.   MonthLength.5  = 31
  3295.   MonthLength.6  = 30
  3296.   MonthLength.7  = 31
  3297.   MonthLength.8  = 31
  3298.   MonthLength.9  = 30
  3299.   MonthLength.10 = 31
  3300.   MonthLength.11 = 30
  3301.   MonthLength.12 = 31
  3302.  
  3303.   call TranslationStrings
  3304.   return
  3305. /**/
  3306.  
  3307. /***//*******  InitializeSettings Subroutine  ***********/
  3308. InitializeSettings:
  3309.   call GetLogInfo
  3310.  
  3311.   if App == 'FW' then do
  3312.     call open('FWPrefs', CurrentDir'FWFiles/FW.Prefs')
  3313.       FWPrefs = readch('FWPrefs', 65535)
  3314.     call close('FWPrefs')
  3315.     ColorTable = pos('SWCL', FWPrefs) + 12
  3316.     EndTable = pos('STUP', FWPrefs)
  3317.     ColorCount = 0
  3318.     Do CTPos = ColorTable to EndTable by 20
  3319.       ColorRegister = c2x(substr(FWPrefs, CTPos - 3, 3))
  3320.       ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
  3321.       if ColorRegister = '000000' then Black$ = ColorList.ColorCount
  3322.       if ColorRegister = 'FFFFFF' then White$ = ColorList.ColorCount
  3323.       ColorCount = ColorCount + 1
  3324.     end
  3325.     ColorList.ColorCount = '<'Clear$'>'
  3326.     ColorCount = ColorCount + 1
  3327.     ColorList.COUNT = ColorCount
  3328.     if symbol('Black$') == 'LIT' then do
  3329.       call AddMsg('W', "The color black can't be found; "ColorList.0" used instead.")
  3330.       Black$ = ColorList.0
  3331.     end
  3332.     if symbol('White$') == 'LIT' then do
  3333.       call AddMsg('W', "The color white can't be found; "ColorList.1" used instead.")
  3334.       White$ = ColorList.1
  3335.     end
  3336.   end
  3337.   else if App == 'PGS' then do
  3338.     GETFONTLIST FontList
  3339.     FontList.COUNT = result
  3340.  
  3341.     call open('PGSColors', CurrentDir''word(PgmVersion, 1)'.colors')
  3342.       PGSColors = readch('PGSColors', 65535)
  3343.     call close('PGSColors')
  3344.     ColorCount = 0
  3345.     StartTag = pos('TG'||'00'x, PGSColors)
  3346.     do while StartTag ~= 0
  3347.       Color = substr(PGSColors, StartTag + 10, c2d(substr(PGSColors, StartTag + 9, 1)))
  3348.       AccentMarker = pos(d2c(129), Color)
  3349.       do while AccentMarker > 0
  3350.         Color = overlay(d2c(c2d(substr(Color, AccentMarker + 1, 1)) + 128), delstr(Color, AccentMarker, 1), AccentMarker)
  3351.         AccentMarker = pos(d2c(129), Color)
  3352.       end
  3353.       ColorList.ColorCount = Color
  3354.       ColorCount = ColorCount + 1
  3355.       StartTag = pos('TG'||'00'x, PGSColors, StartTag + 10)
  3356.     end
  3357.     ColorList.ColorCount = '<'Clear$'>'
  3358.     ColorCount = ColorCount + 1
  3359.     ColorList.COUNT = ColorCount
  3360.     White$ = ColorList.0
  3361.     Black$ = ColorList.1
  3362.   end
  3363.  
  3364.   DefaultColor = Black$
  3365.   DefaultBackground = White$
  3366.  
  3367.   RequesterVariables = 1
  3368.   if App == 'PGS' then do
  3369.     GETDOCUMENTS dummy; DocCount = result
  3370.     if DocCount > 0 then do
  3371.       call bguireq('1b'x||"cYou "||'1b'x||"bmust"||'1b'x||"-b close all other",
  3372.                    ||'0a'x||"documents before using FWCalendar.","*"OK$,'',,PubScreen)
  3373.       call CleanUp
  3374.     end
  3375.   end
  3376.  
  3377.   VarLoc = VarListLoc()
  3378.   return
  3379. /**/
  3380.  
  3381. /***//*******  SetVariables Subroutine  ***********/
  3382. SetVariables:
  3383.   CNotice     = 'Created w/ FWCalendar © Ron Goertz'
  3384.   FSize.4pt   = 4
  3385.   Font.4pt    = DefaultFont
  3386.  
  3387.   DoJulian     = upper(DoJulian)
  3388.   DoJulianLeft = upper(DoJulianLeft)
  3389.   ShiftLMini   = ShiftLMini / 720
  3390.   ShiftRMini   = ShiftRMini / 720
  3391.  
  3392.   if (PhaseLib ~= 1) & (DoPhases ~= 0) then do
  3393.     call AddMsg('W', 'date.library or rexxmathlib.library are required to calculate the moon phases.')
  3394.     DoPhases = 0
  3395.   end
  3396.  
  3397.   do i = 0 to 6
  3398.     val = i - StartWeek
  3399.     if val < 0 then val = 7 + val
  3400.     interpret 'Day.'D.i '=' val
  3401.     interpret 'Day.val = 'D.i'$'
  3402.   end
  3403.  
  3404.   if App == 'FW' then do
  3405.     TextBase = TextAdj
  3406.     do i = 0 to FontTypes
  3407.       if Font.i == NameOnly(Font.i) then Font.i = CurrentDir'FWFonts/SWOLFonts/'Font.i
  3408.       if ~exists(Font.i) then do
  3409.         call AddMsg('W', NameOnly(Font.i)" can't be found; "DefaultFont" used instead.")
  3410.         Font.i = DefaultFont
  3411.       end
  3412.     end
  3413.     if Bold.MiniCal == NameOnly(Bold.MiniCal) then Bold.MiniCal = CurrentDir'FWFonts/SWOLFonts/'Bold.MiniCal
  3414.     if ~exists(Bold.MiniCal) then do
  3415.       call AddMsg('W', NameOnly(Bold.MiniCal)" can't be found; "DefaultBold" used instead.")
  3416.       Bold.MiniCal = DefaultBold
  3417.     end
  3418.     if Bold.FYMiniCal == NameOnly(Bold.FYMiniCal) then Bold.FYMiniCal = CurrentDir'FWFonts/SWOLFonts/'Bold.FYMiniCal
  3419.     if ~exists(Bold.FYMiniCal) then do
  3420.       call AddMsg('W', NameOnly(Bold.FYMiniCal)" can't be found; "DefaultBold" used instead.")
  3421.       Bold.FYMiniCal = DefaultBold
  3422.     end
  3423.     PAGESETUP ORIENT Orientation
  3424.     if upper(Orientation) == 'WIDE' then TextArea = WTextArea
  3425.     else TextArea = TTextArea
  3426.  
  3427.     GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
  3428.     DISPLAYPREFS Measure Inches
  3429.     SECTIONSETUP TOP Margin.Top BOTTOM Margin.Bottom INSIDE Margin.Left OUTSIDE Margin.Right
  3430.     GETPAGESETUP Width Height
  3431.     parse var result FullWidth FullHeight
  3432.   end
  3433.   else if App = 'PGS' then do
  3434.     TextBase = 1
  3435.     do i = 0 to FontTypes
  3436.       do j = 0 to FontList.COUNT - 1
  3437.         if upper(Font.i) == upper(FontList.j) then leave
  3438.       end
  3439.       if j == FontList.COUNT then do
  3440.         call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
  3441.         Font.i = DefaultFont
  3442.       end
  3443.     end
  3444.     do j = 0 to FontList.COUNT - 1
  3445.       if upper(Bold.MiniCal) == upper(FontList.j) then leave
  3446.     end
  3447.     if j == FontList.COUNT then do
  3448.       call AddMsg('W', Bold.MiniCal" can't be found; "DefaultBold" used instead.")
  3449.       Bold.MiniCal = DefaultBold
  3450.     end
  3451.     do j = 0 to FontList.COUNT - 1
  3452.       if upper(Bold.FYMiniCal) == upper(FontList.j) then leave
  3453.     end
  3454.     if j == FontList.COUNT then do
  3455.       call AddMsg('W', Bold.FYMiniCal" can't be found; "DefaultBold" used instead.")
  3456.       Bold.FYMiniCal = DefaultBold
  3457.     end
  3458.  
  3459.     if upper(Orientation) == 'WIDE' then do
  3460.       TextArea = WTextArea
  3461.       Orientation = 'LANDSCAPE'
  3462.     end
  3463.     else do
  3464.       TextArea = TTextArea
  3465.       Orientation = 'PORTRAIT'
  3466.     end
  3467.  
  3468.     if CalType == 1 then DocName = '"'EnteredYear''Mn''Calendar$'"'
  3469.     else DocName = '"'EnteredYear''Calendar$'"'
  3470.     PageName = '"FWCalendar by Ron Goertz"'
  3471.     NEWDOCUMENT DocName
  3472.     NEWMASTERPAGE PageName PageWidth PageHeight SINGLE Orientation
  3473.     SETMARGINGUIDES Margin.Left Margin.Right Margin.Top Margin.Bottom MASTERPAGE PageName
  3474.     SETDIMENSIONS PageWidth PageHeight SINGLE Orientation MASTERPAGE PageName
  3475.     SETCOLUMNGUIDES 0 0 MASTERPAGE PageName
  3476.     SETDOCUMENTSTATUS unchanged DOCUMENT DocName
  3477.     OPENWINDOW '"View 1"' DOCUMENT DocName PAGE 1
  3478.     GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
  3479.     UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
  3480.     SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
  3481.     GETMARGINGUIDES temp MASTERPAGE PageName
  3482.     if rc == 0 then do
  3483.       Margin.Left   = temp.inside
  3484.       Margin.Right  = temp.outside
  3485.       Margin.Top    = temp.top
  3486.       Margin.Bottom = temp.bottom
  3487.     end
  3488.     GETDIMENSIONS temp MASTERPAGE PageName
  3489.     CmdSuccess = rc
  3490.     if Orientation = 'LANDSCAPE' then do
  3491.       if CmdSuccess == 0 then do
  3492.         FullWidth  = temp.height
  3493.         FullHeight = temp.width
  3494.       end
  3495.       else do
  3496.         FullWidth  = PageHeight
  3497.         FullHeight = PageWidth
  3498.       end
  3499.     end
  3500.     else do
  3501.       if CmdSuccess == 0 then do
  3502.         FullWidth  = temp.width
  3503.         FullHeight = temp.height
  3504.       end
  3505.       else do
  3506.         FullWidth  = PageWidth
  3507.         FullHeight = PageHeight
  3508.       end
  3509.     end
  3510.     CURRENTWINDOW; winName = '"'RESULT'"'
  3511.   end
  3512.   PrintWidth  = FullWidth - Margin.Left - Margin.Right
  3513.   PrintHeight = FullHeight - Margin.Top - Margin.Bottom
  3514.  
  3515.  
  3516.   if CalType == 1 then do
  3517.     Height.4pt = GetHeight(4pt)
  3518.  
  3519.     if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then do
  3520.       DoCopyright = 1
  3521.       PrintHeight = PrintHeight - Height.4pt
  3522.     end
  3523.     else DoCopyright = 0
  3524.  
  3525.     BoxWidth    = PrintWidth/7
  3526.     CalRight    = Margin.Left + BoxWidth * 7
  3527.  
  3528.     TextArea        = TextArea * PrintHeight
  3529.     CalTop          = TextArea + Margin.Top
  3530.     BoxHeight       = (PrintHeight - TextArea)/5
  3531.     MoonRadius      = BoxHeight * MoonRadius
  3532.     DateOffset      = DateOffset * BoxWidth
  3533.     MiniCalHeight   = TextArea * MiniCalHeight
  3534.     MiniCalWidth    = MiniCalHeight * MiniCalWidth
  3535.  
  3536.     FSize.Highlight = BoxHeight/HighlightRows * 72
  3537.     FSize.Extras    = FSize.Highlight * MagnifyExtras
  3538.     FSize.Date      = BoxHeight/HighlightRows * 72 * StretchDateH
  3539.     Width.Date      = 100 * StretchDateW / StretchDateH
  3540.     FSize.Weekday   = (TextArea - MiniCalHeight) * WeekdaySize * 72
  3541.     FSize.Header    = TextArea * HeaderSize * 72
  3542.  
  3543.     if App == 'FW' then do
  3544.       FSize.MiniCal  = MiniCalHeight/6 * 72
  3545.       do i = 0 to 6
  3546.         FSize.i = min(max(trunc(FSize.i), 4), 360)
  3547.         Width.i = min(max(trunc(Width.i), 4), 255)
  3548.       end
  3549.     end
  3550.     else if App == 'PGS' then FSize.MiniCal  = MiniCalHeight/7 * 72
  3551.  
  3552.     Height.Highlight = FSize.Highlight / 4 * Height.4pt * Leading/100
  3553.     Height.Date      = FSize.Date / 4 * Height.4pt * Leading/100
  3554.     Height.Weekday   = FSize.Weekday / 4 * Height.4pt * Leading/100
  3555.     Height.Header    = FSize.Header / 4 * Height.4pt * Leading/100
  3556.     Height.MiniCal   = FSize.MiniCal / 4 * Height.4pt * Leading/100
  3557.     Height.Extras    = FSize.Extras / 4 * Height.4pt * Leading/100
  3558.  
  3559.     if DoMiniCals == 1 then call GetMiniMax(MiniCal)
  3560.   end
  3561.   else do
  3562.     Height.4pt = GetHeight(4pt)
  3563.  
  3564.     if ((((PrintHeight - (3 * MiniCalSpacing) - Height.4pt) / 4 ) / 7) * 72) >= 4 then DoCopyright = 1
  3565.     else DoCopyright = 0
  3566.  
  3567.     MiniCalSpacing  = PrintWidth * MiniCalSpacing
  3568.     MiniCalWidth    = (PrintWidth - 2 * MiniCalSpacing)/3
  3569.     FSize.FYMiniCal = (((PrintHeight - (3 * MiniCalSpacing) - (Height.4pt * DoCopyright)) / 4 ) / 7) * 72
  3570.     if App == 'FW' then FSize.FYMiniCal = max(trunc(FSize.FYMiniCal), 4)
  3571.     Height.FYMiniCal = FSize.FYMiniCal / 4 * Height.4pt * Leading/100
  3572.     call GetMiniMax(FYMiniCal)
  3573.   end
  3574.  
  3575.   if App == 'FW' then do
  3576.     FIRSTOBJECT; ObjID = result
  3577.     SELECTOBJECT ObjID
  3578.     do forever
  3579.       NEXTOBJECT ObjID; ObjID = result
  3580.       if ObjID == 0 then leave
  3581.       SELECTOBJECT ObjID MULTIPLE
  3582.     end
  3583.     DELETEOBJECT
  3584.   end
  3585.   VariablesSet = 1
  3586.   if ErrorCount > 0 then call Cleanup
  3587. return
  3588. /**/
  3589.  
  3590. /***//*******  TranslationStrings () Subroutine  ***********/
  3591. TranslationStrings:
  3592. Backgrounds$    = 'Backgrounds'
  3593. Bottom$         = 'Bottom'
  3594. BoxColor$       = 'Box:'
  3595. BoxDates$       = 'Box Dates'
  3596. Boxed$          = '_Boxed:'
  3597. Calendar$       = 'Calendar'
  3598. Cancel$         = '_Cancel'
  3599. CantFind$       = "can't be found"
  3600. CantMatch$      = "The export file can't be the"||'0a'x||"same as the preferences file"
  3601. CantOpen$       = "can't be opened"
  3602. Center$         = 'Center'
  3603. Clear$          = 'Clear'
  3604. Colors$         = 'Colors'
  3605. Critical$       = 'Critical error'
  3606. DailyColors$    = 'Use daily colors'
  3607. Easter$         = 'Easter'
  3608. End$            = 'End:'
  3609. EnterEvent$     = 'You must enter an event...'
  3610. EnterEventInfo$ = 'Enter event information:'
  3611. EnterStartdate$ = 'You must enter a start date...'
  3612. Event$          = 'Event:'
  3613. Export$         = 'E_xport'
  3614. ExportFile$     = 'Select export file:'
  3615. Exporting$      = 'Exporting'
  3616. Extended$       = 'Extended'
  3617. File$           = 'File:'
  3618. Font$           = 'Font:'
  3619. Fonts$          = 'Fonts'
  3620. ForDetails$     = 'for details'
  3621. ForwardContent$ = 'Forward contents of output to'
  3622. ForwardLog$     = 'Forward log file to'
  3623. GeneratingM$    = 'Generating %s %s calendar'
  3624. GeneratingY$    = 'Generating %s calendar'
  3625. GenMVars        = 'Month.Month EnteredYear'
  3626. GenYVars        = 'EnteredYear'
  3627. Highlights$     = 'Highlights'
  3628. Images$         = 'Images'
  3629. Julian$         = 'Julian'
  3630. JulJulLeft$     = 'Jul/Jul Left'
  3631. JulLeft$        = 'Jul Left'
  3632. Left$           = 'Left'
  3633. Line$           = '_Line:'
  3634. Load$           = '_Load'
  3635. MatchColors$    = 'Date Color = Highlight Color'
  3636. MiniCals$       = 'MiniCals'
  3637. MiscVar$        = 'Miscellaneous Variables'
  3638. Monthly$        = '_Monthly'
  3639. MustUse$        = "You must use the gadget to"||'0a'x||"the right to select a font."
  3640. Noncritical$    = 'Noncritical warning'
  3641. None$           = 'None'
  3642. NotClear$       = '<'Clear$'> can only be used for "Background." variables...'
  3643. Notice$         = 'notice'
  3644. OK$             = '_OK'
  3645. Options$        = 'Options'
  3646. OptLayout$      = 'Options & Layout'
  3647. OrientMarg$     = 'Orientation & Margins'
  3648. Phases$         = 'Phases'
  3649. PleaseWait$     = 'Please wait'
  3650. PrepReq$        = 'Preparing requester'
  3651. ProcessEvents$  = 'Processing events'
  3652. Reset$          = '_Reset'
  3653. Right$          = 'Right'
  3654. RiseSet$        = 'Rise/Set'
  3655. See$            = 'see'
  3656. SeeOutput$      = 'see the output above for details'
  3657. SeeShell$       = 'see the shell output for details'
  3658. SelectFile$     = 'Select data file:'
  3659. SelectFont$     = 'Select font:'
  3660. Start$          = 'Start:'
  3661. Sunrise$        = 'Sunrise'
  3662. Sunset$         = 'Sunset'
  3663. Tall$           = 'Tall'
  3664. TextColor$      = 'Text:'
  3665. Top$            = 'Top'
  3666. Unable$         = 'if you are unable to resolve the problem.'
  3667. VarGUITitle$    = 'Set desired variables:'
  3668. Variables$      = 'Variables'
  3669. Weekly$         = '_Weekly:'
  3670. Weeknumber$     = 'Weeknumber'
  3671. WholeYear$      = 'Whole _Year'
  3672. Wide$           = 'Wide'
  3673.  
  3674. January$   = 'January'
  3675. February$  = 'February'
  3676. March$     = 'March'
  3677. April$     = 'April'
  3678. May$       = 'May'
  3679. June$      = 'June'
  3680. July$      = 'July'
  3681. August$    = 'August'
  3682. September$ = 'September'
  3683. October$   = 'October'
  3684. November$  = 'November'
  3685. December$  = 'December'
  3686.  
  3687. Sunday$    = 'Sunday'
  3688. Monday$    = 'Monday'
  3689. Tuesday$   = 'Tuesday'
  3690. Wednesday$ = 'Wednesday'
  3691. Thursday$  = 'Thursday'
  3692. Friday$    = 'Friday'
  3693. Saturday$  = 'Saturday'
  3694. return 0
  3695. /**/
  3696.  
  3697. /***//*******  VarList () Subroutine  ***********/
  3698. ReturnVarListLoc:
  3699.   return SIGL + 2
  3700. VarListLoc:
  3701.   /* WTextArea      = fraction of print height used for top of calendar (Wide) */
  3702.   /* TTextArea      = fraction of print height used for top of calendar (Tall) */
  3703.   /* DateOffset     = fraction of box width to offset dates from edge of box   */
  3704.   /* MiniCalHeight  = fraction of text area height used for minicals           */
  3705.   /* MiniCalWidth   = width-to-height ratio for minicals                       */
  3706.   /* MiniCalSpacing = fraction of print width placed between FY minicals       */
  3707.   signal ReturnVarListLoc
  3708. VarList:
  3709.   AddEventRows          = 9
  3710.   AdjustDST             = 1
  3711.   AltColor.Date         = Black$
  3712.   AltColor.Extended     = Black$
  3713.   AltColor.Highlight    = Black$
  3714.   AltColor.HighlightH   = Black$
  3715.   AltColor.Julian       = Black$
  3716.   AltColor.Sunrise      = Black$
  3717.   AltColor.Sunset       = Black$
  3718.   AltColor.WeekNumber   = Black$
  3719.   Background.AddEvent   = White$
  3720.   Background.Highlight  = White$
  3721.   Background.HighlightH = White$
  3722.   Background.MiniCal    = White$
  3723.   Background.Weekend    = White$
  3724.   BelzierFactor         = .55
  3725.   Bold.MiniCal          = DefaultBold
  3726.   Bold.FYMiniCal        = DefaultBold
  3727.   CenterMiniDates       = 1
  3728.   Color.Sunday          = Black$
  3729.   Color.Monday          = Black$
  3730.   Color.Tuesday         = Black$
  3731.   Color.Wednesday       = Black$
  3732.   Color.Thursday        = Black$
  3733.   Color.Friday          = Black$
  3734.   Color.Saturday        = Black$
  3735.   Color.AddEvent        = Black$
  3736.   Color.Date            = Black$
  3737.   Color.Extended        = Black$
  3738.   Color.Header          = Black$
  3739.   Color.Highlight       = Black$
  3740.   Color.HighlightH      = Black$
  3741.   Color.Julian          = Black$
  3742.   Color.MiniCal         = Black$
  3743.   Color.Moon            = Black$
  3744.   Color.Sunrise         = Black$
  3745.   Color.Sunset          = Black$
  3746.   Color.Weekday         = Black$
  3747.   Color.WeekNumber      = Black$
  3748.   DateOffset            = 0.02
  3749.   DoBackgrounds         = 0
  3750.   DoDailyColors         = 0
  3751.   DoDateBox             = 0
  3752.   DoEaster              = 1
  3753.   DoExtended            = 1
  3754.   DoHide                = 0
  3755.   DoHighlights          = 0
  3756.   DoImages              = 0
  3757.   DoJulian              = 0
  3758.   DoJulianLeft          = 0
  3759.   DoMatchColors         = 0
  3760.   DoMiniCals            = 1
  3761.   DoPhases              = 0
  3762.   DoShanghai            = 1
  3763.   DoSunRise             = 0
  3764.   DoSunSet              = 0
  3765.   DoWeekNumber          = 0
  3766.   FinalView             = 75
  3767.   Font.Date             = DefaultFont
  3768.   Font.Extras           = DefaultFont
  3769.   Font.Header           = DefaultFont
  3770.   Font.Highlight        = DefaultFont
  3771.   Font.MiniCal          = DefaultFont
  3772.   Font.FYMiniCal        = DefaultFont
  3773.   Font.Weekday          = DefaultFont
  3774.   GfxApp                = 'Visage'
  3775.   GfxAppPath            = ''
  3776.   GfxCmd                = '%s info'
  3777.   GfxTemplate           = '. "0a"x . ImgDT ImgWidth "x" ImgHeight "x" .'
  3778.   HeaderLoc             = 2
  3779.   HeaderSize            = .5
  3780.   HighlightRows         = 9
  3781.   LaunchM               = ''
  3782.   LaunchY               = ''
  3783.   Leading               = 100
  3784.   Line.AddEvent         = Black$
  3785.   Line.Extended         = Black$
  3786.   Line.Grid             = Black$
  3787.   Line.MiniCal          = Black$
  3788.   MagnifyExtras         = 1
  3789.   Margin.Bottom         = 0
  3790.   Margin.Left           = 0
  3791.   Margin.Right          = 0
  3792.   Margin.Top            = 0
  3793.   MinWidth              = 80
  3794.   MaxImgHeight          = .75
  3795.   MaxImgWidth           = .75
  3796.   MiniCalHeight         = 0.60
  3797.   MiniCalSpacing        = 0.005
  3798.   MiniCalWidth          = 2.00
  3799.   MoonRadius            = .1
  3800.   Orientation           = 'Wide'
  3801.   PrefsName             = ''
  3802.   ShiftLMini            = 0
  3803.   ShiftRMini            = 0
  3804.   StartWeek             = 0
  3805.   StretchDateH          = 1
  3806.   StretchDateW          = 1
  3807.   SunCalcPath           = ''
  3808.   Text.Julian           = ''
  3809.   Text.Sunrise          = ''
  3810.   Text.Sunset           = ''
  3811.   Text.WeekNumber       = ''
  3812.   WeekdaySize           = .5
  3813. return
  3814. /**/
  3815.  
  3816.